Wed Jun 10 13:55:55 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * Fix ownership transfer for non cxx:class objects.
diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp
--- old-smoke/src/clos.lisp	2015-09-02 05:06:27.950982414 +0200
+++ new-smoke/src/clos.lisp	2015-09-02 05:06:28.362953893 +0200
@@ -190,6 +190,10 @@
     (assert (subtypep (class-of superclass) (find-class 'smoke-standard-class))
             ((first direct-superclasses))
             "The first superclass must be an subclass of an smoke class.")
+    (assert (virtual-destructor-p superclass)
+            ()
+            "The class ~A has a non virtual destructor." superclass)
+            
     (apply
      #'call-next-method class
      :id (id superclass)
@@ -301,7 +305,8 @@
         (push-smoke-stack stack converted-value (type-id type))
         (when (stack-p type) ;; Pass by value => smoke deletes the object.
           (cancel-finalization converted-value)
-          (transfer-ownership-to value object))))))
+          (when (typep value 'smoke-standard-object)
+            (transfer-ownership-to value object)))))))
 
 (defun get-gf-for-method (smoke-method)
   (declare (smoke-method smoke-method)
@@ -445,9 +450,9 @@
     ret))
 
 (defun keep-wrapper (object new-owner)
-  (assert (not (member object (owned-objects new-owner)))
-          ()
-          "~A has already been called for ~A." #'keep-wrapper object)
+  (when (member object (owned-objects new-owner))
+    (cerror "ignore" "~A has already been called for ~A."
+            #'keep-wrapper object))
   (push object (owned-objects new-owner)))
 
 (defun remove-wrapper-object (object owner)
@@ -456,18 +461,10 @@
 (defun transfer-ownership-to (object new-owner)
   "Transfers the ownership of OBJECT to C++."
   (cancel-finalization object)
-  (if (typep (class-of object) 'cxx:class)
-      (progn
-        (assert (virtual-destructor-p (class-of object))
-                ()
-                "The ownership of the object ~A is transfered to C++, but
-it has a nonvirtual destructor." object)
-        (keep-wrapper object new-owner))
-      (when (and (typep object 'smoke-standard-object)
-                 (not (virtual-destructor-p (class-of object))))
-        (remove-object (pointer object)))))
+  (if (virtual-destructor-p (class-of object))
+      (keep-wrapper object new-owner)
+      (remove-object (pointer object))))
       
-
 (defun take-ownership (object &optional current-owner)
   "Assigns the ownership of OBJECT to Lisp. i.e.:
 cl-smoke is responsible for deleting the object."