Wed Sep  2 13:49:34 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * Various fixes:
  
  * Allow user conversions for return values
  * fix destruction of objects with multiple C++ superclasses
  * Fix list to QList conversion dispatch
diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp
--- old-smoke/src/clos.lisp	2014-10-30 08:10:34.000000000 +0100
+++ new-smoke/src/clos.lisp	2014-10-30 08:10:34.000000000 +0100
@@ -267,6 +267,11 @@
     ;; in a finalizer. In that case the object is already removed from
     ;; *object-map* when the callback is invoked. Thus OBJECT can be NIL.
     (when object
+      (when (typep object 'smoke-multi-superclass-mixin)
+        (dolist (extra-object (extra-objects object))
+          (unless (null-pointer-p (pointer extra-object))
+            (remove-object (pointer extra-object))
+            (delete-object extra-object))))
       (remove-finalizer object)
       (remove-object object-pointer)
       (setf (slot-value object 'pointer) (null-pointer)))))
@@ -289,32 +294,34 @@
                                              arg)
                            args))))
 
-(defun convert-argument (argument type &optional (user t))
-  "Returns ARGUMENT converted to TYPE. If USER is true, user defined
-conversion sequences are considered."
-  (let ((rank (get-conversion-sequence argument type user)))
-    (if (null rank)
-        (error "Can not convert the argument ~S to ~A."
-               argument (name type))
-        (funcall (conversion-function-name rank)
-                 argument))))
+(defun convert-argument (argument type &optional disown)
+  "Returns ARGUMENT converted to TYPE and removes the ownership when
+it is passed on the stack."
+  (flet ((disown (object)
+           (remove-finalizer object)
+           (when (typep object 'smoke-standard-object)
+             (remove-object (pointer object)))))
+    (let ((rank (get-conversion-sequence argument type nil)))
+      (if (null rank)
+          (let ((rank (get-conversion-sequence argument type t)))
+            (if (null rank)
+                (error "Can not convert the argument ~S to ~A."
+                       argument (name type))
+                (let ((ret (funcall (conversion-function-name rank)
+                                    argument)))
+                  (when (and disown (stack-p type))
+                    (disown ret))
+                  ret)))
+          (prog1 (funcall (conversion-function-name rank) argument)
+            (when (and disown (stack-p type))
+              (disown argument)))))))
 
 (defun put-returnvalue (stack value type object)
   (unless (void-p type)
     (let ((stack (make-call-stack stack)))
       (setf (call-stack-top stack) (call-stack-pointer stack))
-      ;; FIXME support user conversions.
-      ;;
-      ;; We need to determine which of value and converted-value is
-      ;; passed on the stack. E.g. converted-value can be something
-      ;; like (cxx:operator-variant value).
-      (let ((converted-value (convert-argument value type nil)))
-        (push-smoke-stack stack converted-value (type-id type))
-        (when (stack-p type) ;; Pass by value => smoke deletes the object.
-          (remove-finalizer converted-value)
-          (when (typep value 'smoke-standard-object)
-            (remove-object (pointer value))))))))
-          ;  (transfer-ownership-to value object)))))))
+      (let ((converted-value (convert-argument value type t)))
+        (push-smoke-stack stack converted-value (type-id type))))))
 
 (defun get-gf-for-method (smoke-method)
   (declare (smoke-method smoke-method)
diff -rN -u old-smoke/src/object-map.lisp new-smoke/src/object-map.lisp
--- old-smoke/src/object-map.lisp	2014-10-30 08:10:34.000000000 +0100
+++ new-smoke/src/object-map.lisp	2014-10-30 08:10:34.000000000 +0100
@@ -112,7 +112,8 @@
 (defun add-object (object)
   "Adds OBJECT to the pointer -> object map. It can later be retrieved
 with GET-OBJECT."
-  (assert (not (has-pointer-p (pointer object))) ()
-          "There exists already a object ~A for the pointer of ~A."
-          (get-object (pointer object)) object)
+  (when (has-pointer-p (pointer object))
+    (cerror "Overwrite the old object."
+            "There exists already a object ~A for the pointer of ~A."
+            (get-object (pointer object)) object))
   (setf (get-object (pointer object)) object))
diff -rN -u old-smoke/src/overload-resolution.lisp new-smoke/src/overload-resolution.lisp
--- old-smoke/src/overload-resolution.lisp	2014-10-30 08:10:34.000000000 +0100
+++ new-smoke/src/overload-resolution.lisp	2014-10-30 08:10:34.000000000 +0100
@@ -302,8 +302,10 @@
 the function CONVERSION-FUNCTION-NAME."
   `(progn ,@(loop for type-name in (ensure-list type-names)
                collect `(setf (gethash ,type-name *from-lisp-translations*)
-                              #'(lambda (type)
-                                  (and (subtypep type ',lisp-type)
+                              #'(lambda (type type-p)
+                                  (and (if type-p
+                                           (subtypep type ',lisp-type)
+                                           (typep type ',lisp-type))
                                        ',conversion-function-name))))))
 
 (define-from-lisp-translation ("void*" "const void*" "void**" "const void**")
@@ -323,7 +325,7 @@
   "Test for an exact match."
   (case (type-id type)
     (0 (when-let (test (gethash (name type) *from-lisp-translations*))
-         (funcall test (object.type-of))))
+         (funcall test object (using-typep))))
     (1 (object.typep 'boolean))
     (2 (object.typep 'standard-char))
     (3 (object.typep '(c-integer :unsigned-char)))