Wed Jun 10 14:09:14 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * Test gc cycle and non cxx:object parent
diff -rN -u old-qt.tests/src/gc.lisp new-qt.tests/src/gc.lisp
--- old-qt.tests/src/gc.lisp	2014-10-30 07:56:57.000000000 +0100
+++ new-qt.tests/src/gc.lisp	2014-10-30 07:56:57.000000000 +0100
@@ -58,7 +58,6 @@
   (let ((objects nil))
     (dotimes (x 10)
       (let ((object (make-instance 'qt:object)))
-;        (cxx:set-parent (make-instance 'my-gc-object) object)
         (make-instance 'my-gc-object :args (list object))
         (push object objects)))
     (gc :full t)))
@@ -69,20 +68,70 @@
   (gc :full t)
   (let ((count (hash-table-count smoke::*object-map*)))
     (eval '(run-gc-child))
+    (eval '(gc :full t))
     (gc :full t)
     (gc :full t)
-    (5am:is (= count (hash-table-count smoke::*object-map*)))))
+    (5am:is (>= count (hash-table-count smoke::*object-map*)))))
 
-(5am:test (gc-lisp-child :depends-on (and gc-child with-app))
+;(5am:test (gc-lisp-child :depends-on (and gc-child with-app))
+(5am:test gc-lisp-child
   "Test garbage collection of a qt:object with a parent."
   (gc :full t)
   (qt:with-core-app
     (let ((count (hash-table-count smoke::*object-map*)))
       (eval '(run-gc-my-child))
+      ;; a.k.a :really-full ;)
       (gc :full t)
       (qt:core-application.send-posted-events)
+      (eval '(gc :full t))
+      (qt:core-application.send-posted-events)
+      (eval '(gc :full t))
+      (qt:core-application.send-posted-events)
       (gc :full t)
       (qt:core-application.send-posted-events)
-      
       ;; allow some objects to be not collected
       (5am:is (>= (+ count 2) (hash-table-count smoke::*object-map*))))))
+
+(defun test-gc-cycle ()
+  (qt:with-core-app
+      (dotimes (i 10)
+        (let ((timer (make-instance 'qt:timer)))
+          (qt:connect (qt:get-signal timer "timeout()")
+                      #'(lambda ()
+                          (format *debug-io* "Timeout ~A" timer)))))
+    (gc :full t)
+    (qt:core-application.send-posted-events)
+    (gc :full t)
+    (qt:core-application.send-posted-events)))
+
+(5am:test (gc-cycle :depends-on gc-lisp-child)
+  "Test GC a unreacable cycle."
+  ;; timer -> qslot -> closure(lambda)
+  ;;   ^------------------/
+  (qt:with-core-app
+  (let ((objects (hash-table-count smoke::*object-map*)))
+    (eval '(test-gc-cycle))
+    (eval '(gc :full t))
+    (qt:core-application.send-posted-events)
+    (eval '(gc :full t))
+    (qt:core-application.send-posted-events)
+    (gc :full t)
+    (qt:core-application.send-posted-events)
+    (gc :full t)
+    (5am:is (>= objects (hash-table-count smoke::*object-map*))))))
+
+(5am:test ownership-transfer-no-wrapper
+  "Test ownership tranasfer of a QObject without a wrapper."
+  (let ((grand-parent (make-instance 'qt:object)))
+    (let* ((parent (make-instance 'qt:object :args (list grand-parent)))
+           (object (make-instance 'my-object :args (list parent))))
+      (declare (ignore object)))
+    (gc :full t)
+    (qt:core-application.send-posted-events)
+    (gc :full t)
+    (qt:core-application.send-posted-events)
+    (5am:is (member (find-class 'my-object)
+                    (loop for c across (cxx:children grand-parent) append
+                         (map 'list #'class-of
+                                 (cxx:children c)))))))
+      
diff -rN -u old-qt.tests/src/signal-slot.lisp new-qt.tests/src/signal-slot.lisp
--- old-qt.tests/src/signal-slot.lisp	2014-10-30 07:56:57.000000000 +0100
+++ new-qt.tests/src/signal-slot.lisp	2014-10-30 07:56:57.000000000 +0100
@@ -113,6 +113,10 @@
     (5am:is (eq nil *destroyed*)))
   (tg:gc :full t))
 
+;; SBCL runs the finalizer when the object has been garbage collected,
+;; thus its children could be to and thus the destroyed() signal is not
+;; received
+#-(or sbcl cmucl)
 (5am:test (destroyed-signal :depends-on gc-qobject)
   "Receive a destroy signal for a QObject."
   (setf *destroyed* nil)