Wed Jun 10 13:55:55 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Fix ownership transfer for non cxx:class objects.

--- old-smoke/src/clos.lisp 2014-09-30 10:29:57.000000000 +0200

+++ new-smoke/src/clos.lisp 2014-09-30 10:29:57.000000000 +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."