Thu Jun 11 17:04:11 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Test adding a child to a no smoke object and fixes for :qt :qt-impl split.

--- old-qt.tests/src/gc.lisp 2014-10-30 07:02:56.000000000 +0100

+++ new-qt.tests/src/gc.lisp 2014-10-30 07:02:56.000000000 +0100

@@ -73,8 +73,7 @@

(gc :full t)

(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

+(5am:test (gc-lisp-child :depends-on (and gc-child with-app))

"Test garbage collection of a qt:object with a parent."

(gc :full t)

(qt:with-core-app

@@ -93,16 +92,15 @@

(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)))

+ (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."

@@ -120,7 +118,7 @@

(gc :full t)

(5am:is (>= objects (hash-table-count smoke::*object-map*))))))

-(5am:test ownership-transfer-no-wrapper

+(5am:test (ownership-transfer-no-wrapper :depends-on gc-lisp-child)

"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)))

@@ -135,3 +133,31 @@

(map 'list #'class-of

(cxx:children c)))))))

+

+(5am:test (gc-non-smoke-object :depends-on gc-lisp-child)

+ "Test adding a child to a non smoke object."

+ (qt:with-app

+ (let ((model (make-instance 'qt:string-list-model

+ :args (list #("a" "b" "c"))))

+ (view (make-instance 'qt:list-view))

+ (counter 0))

+ (setf (cxx:model view) model)

+ (qt:connect (qt:get-signal (cxx:selection-model view)

+ "selectionChanged(QItemSelection, QItemSelection)")

+ #'(lambda (selected deselected)

+ (declare (ignore selected deselected))

+ (incf counter)))

+ (gc :full t)

+ (qt:core-application.send-posted-events)

+ (gc :full t)

+ (qt:core-application.send-posted-events)

+ (5am:is (= 0 counter))

+ (cxx:select (cxx:selection-model view)

+ (cxx:index model 0)

+ qt:item-selection-model.+toggle+)

+ (5am:is (= 1 counter))

+ (cxx:select (cxx:selection-model view)

+ (cxx:index model 1)

+ qt:item-selection-model.+toggle+)

+ (5am:is (= 2 counter)))))

+

--- old-qt.tests/src/properties.lisp 2014-10-30 07:02:56.000000000 +0100

+++ new-qt.tests/src/properties.lisp 2014-10-30 07:02:56.000000000 +0100

@@ -5,8 +5,7 @@

(5am:test property-list

"Test properties"

(5am:is (= 1 (length (qt:class-properties (find-class 'qt:object)))))

- (5am:is (= 1 (length (qt:properties (make-instance 'qt:object)))))

- (5am:is (= 1 (length (qt:class-properties (find-class 'qt:qslot))))))

+ (5am:is (= 1 (length (qt:properties (make-instance 'qt:object))))))

(5am:test (property :depends-on qstring)

"Tests get and set property string"

--- old-qt.tests/src/signal-slot.lisp 2014-10-30 07:02:56.000000000 +0100

+++ new-qt.tests/src/signal-slot.lisp 2014-10-30 07:02:56.000000000 +0100

@@ -6,7 +6,7 @@

(5am:test simple-signal-slot

"Test custom signal to custom slot connection."

(let ((counter 0))

- (let ((my-signal (make-instance 'qt:qsignal))

+ (let ((my-signal (qt:make-signal))

(my-slot (qt::make-slot #'(lambda () (incf counter))

nil)))

@@ -93,7 +93,7 @@

"Pass a lisp object over a signal-slot connection."

(let ((num 1d0)

(count 0))

- (let ((my-signal (make-instance 'qt:qsignal))

+ (let ((my-signal (qt:make-signal))

(my-slot (qt::make-slot #'(lambda (a b)

(5am:is (eq a num))

(5am:is (eql t b))