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
hunk ./src/clos.lisp 270
+ (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))))
hunk ./src/clos.lisp 297
-(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)))))))
hunk ./src/clos.lisp 323
- ;; 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))))))
hunk ./src/object-map.lisp 115
- (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))
hunk ./src/overload-resolution.lisp 305
- #'(lambda (type)
- (and (subtypep type ',lisp-type)
+ #'(lambda (type type-p)
+ (and (if type-p
+ (subtypep type ',lisp-type)
+ (typep type ',lisp-type))
hunk ./src/overload-resolution.lisp 328
- (funcall test (object.type-of))))
+ (funcall test object (using-typep))))