Sun May 24 13:42:39 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Signal slot finalization fix
diff -rN -u old-qt.gui/src/signal-slot/translate.lisp new-qt.gui/src/signal-slot/translate.lisp
--- old-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:01:24.000000000 +0100
+++ new-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:01:25.000000000 +0100
@@ -44,11 +44,21 @@
(translate-cxx-lisp-object
(mem-ref argument :pointer)))))))))
+(defun disown-object (object)
+ (tg:cancel-finalization object)
+ (unless (smoke::virtual-destructor-p (class-of object))
+ (smoke::remove-object (pointer object)))
+ object)
+
(defun pointer-to-lisp (pointer type)
+ "Returns the lisp value or object at POINTER of type TYPE."
(if (smoke::class-p type)
(if (smoke::pointer-p type)
(smoke::object-to-lisp (mem-ref pointer :pointer) type)
- (smoke::object-to-lisp pointer type))
+ ;; By value means that they are allocated by the C++ signal
+ ;; code and have dynamic extend in the slot. The C++ singal code
+ ;; frees the object when the slot returns.
+ (disown-object (smoke::object-to-lisp pointer type)))
(ecase (smoke::type-id type)
(0 (let ((cffi-type (smoke::get-type (name type))))
(if (null cffi-type)
@@ -73,12 +83,14 @@
(defun arguments-to-lisp (arguments types)
+ "Returns ARGUMENTS for a slot invocation as lisp objects."
(arguments-to-lisp2 (inc-pointer arguments ;; index 0 is for the return value
(foreign-type-size :pointer))
types ()))
(defun get-type (smoke-type)
+ "Returns the QMetaType ID for SMOKE-TYPE."
(typecase smoke-type
(smoke::smoke-standard-object
(if (smoke::pointer-p smoke-type)
@@ -94,6 +106,7 @@
(defun types (smoke-types)
+ "Returns a newly allocated array of QMetaType IDs of SMOKE-TYPES."
;;FIXME free TYPES on error.
(let ((types (cffi:foreign-alloc :int :count (1+ (length smoke-types))))
(index 0))
diff -rN -u old-qt.gui/src/variant.lisp new-qt.gui/src/variant.lisp
--- old-qt.gui/src/variant.lisp 2014-10-30 07:01:24.000000000 +0100
+++ new-qt.gui/src/variant.lisp 2014-10-30 07:01:25.000000000 +0100
@@ -4,7 +4,7 @@
"Print the type and value of the variant."
(if (null-pointer-p (pointer variant))
(call-next-method)
- (print-unreadable-object (variant stream :type t)
+ (print-unreadable-object (variant stream :type t :identity t)
(format stream "~A~@[ ~S~]"
(cxx:type-name variant)
(handler-case (from-variant variant)