Fri Apr  3 00:17:02 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * initial import
diff -rN -u old-qt.tests/qt.tests.mbd new-qt.tests/qt.tests.mbd
--- old-qt.tests/qt.tests.mbd	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/qt.tests.mbd	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,22 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+
+(in-package :sysdef-user)
+
+(define-system :qt.tests ()
+  (:version 0 0 1)
+  (:documentation "Qt unit tests.")
+  (:needs :qt :qt.test :FiveAM :trivial-garbage)
+  (:components 
+  	("src" module
+            (:components "package"
+                         ("tests" (:needs "package"))
+                         ("qbytearray" (:needs "tests"))
+                         ("qstring" (:needs "tests"))
+                         ("overload" (:needs "tests"))
+                         ("gc" (:needs "tests"))
+                         ("variant" (:needs "tests"))
+                         ("application" (:needs "tests"))
+                         ("signal-slot" (:needs "tests"))
+                         ("thread" (:needs "tests"))
+                         ("properties" (:needs "tests"))
+                         ("click" (:needs "tests"))))))
diff -rN -u old-qt.tests/src/application.lisp new-qt.tests/src/application.lisp
--- old-qt.tests/src/application.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/application.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,26 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(5am:test with-app
+  "Tests qt:with-app and qt:with-core-app"
+  (5am:for-all ((core-p (5am:gen-one-element nil t)))
+    (5am:is (eql nil (qt:app-p)))
+    (if core-p
+        (qt:with-core-app
+          (5am:is (eql t (qt:app-p)))
+          (5am:is (typep (qt:app) (find-class 'qt:core-application)))
+          (cxx:set-object-name (qt:app) "core-app")) ;; test for memfault
+        (qt:with-app
+          (5am:is (eql t (qt:app-p)))
+          (5am:is (typep (qt:app) (find-class 'qt:application)))
+          (cxx:set-object-name (qt:app) "app")))
+    (5am:is (eql nil (qt:app-p)))))
+
+(5am:test application-nest
+  "Test qt:with-core-app nesting."
+  (qt:with-core-app
+    (5am:is (eql (qt:app) (qt:core-application.instance)))
+    (qt:with-core-app
+      (5am:is (eql (qt:app) (qt:core-application.instance))))))
+  
diff -rN -u old-qt.tests/src/click.lisp new-qt.tests/src/click.lisp
--- old-qt.tests/src/click.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/click.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,41 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(defclass click-test-widget (qt:push-button)
+  ()
+  (:metaclass cxx:class))
+
+(5am:test (click-test :depends-on with-app)
+  "Test clicking a button."
+  (qt:with-app
+    (let ((widget (make-instance 'click-test-widget))
+          (click-count 0))
+      (qt:connect (qt:get-signal widget "clicked()")
+                  #'(lambda ()
+                      (incf click-count)))
+                             
+      (cxx:set-text widget "Hello World")
+      (5am:is (string= "Hello World" (cxx:text widget)))
+
+      (5am:is (= 0 click-count))
+      (qt.test:test.mouse-click widget qt:+left-button+)
+      (5am:is (= 1 click-count))
+      (qt.test:test.mouse-click widget qt:+right-button+)
+      (5am:is (= 1 click-count)))))
+
+(5am:test (click-test-bool :depends-on click-test)
+  "Test clicking a button (bool argument)."
+  (qt:with-app
+    (let ((widget (make-instance 'click-test-widget))
+          (click-count 0))
+      (qt:connect (qt:get-signal widget "clicked(bool)")
+                  #'(lambda (checked)
+                      (5am:is (eql t checked))
+                      (incf click-count)))
+      (5am:is (= 0 click-count))
+      (qt.test:test.mouse-click widget qt:+left-button+)
+      (5am:is (= 1 click-count))
+      (qt.test:test.mouse-click widget qt:+left-button+)
+      (5am:is (= 2 click-count)))))
+
diff -rN -u old-qt.tests/src/gc.lisp new-qt.tests/src/gc.lisp
--- old-qt.tests/src/gc.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/gc.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,86 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+;;; The GC stuff depends on (gc :full t) to collect the consed objects.
+;;; Sometimes calling GC twice helps in sbcl.
+
+(defun test-gc (class)
+  "Returns true when some instances of class get garbage collected
+and false otherwise.
+It is not required that every instance is gc'ed, since this rarly happens
+and is not a bug."
+  (let ((objects nil))
+    (dotimes (x 9)
+      (let ((object (make-instance class)))
+        (push (make-weak-pointer object)
+              objects)))
+    (dotimes (x 2)
+      (gc :full t))
+    (5am:is (eql t
+                 (some #'(lambda (o) (null (weak-pointer-value o)))
+                       objects)))))
+
+(defclass lisp-object ()
+  ((a :initform (make-array '(1000 1000) :initial-element 3))
+   (b :initform (list 1 2 43)))
+  (:documentation "For the object to be (hopefully) garbage colleted
+we cons up some memory."))
+
+(5am:test gc-lisp-object
+  "Ensure that GC works for plain lisp objects."
+  (test-gc 'lisp-object))
+
+(5am:test (gc-object :depends-on gc-lisp-object)
+  "Test garbage collection of a no QObject class."
+  (test-gc 'qt:byte-array))
+
+(5am:test (gc-qobject :depends-on gc-object)
+  "Test garbage collection of a QObject."
+  (test-gc 'qt:object))
+
+(defclass my-gc-object (qt:object)
+  ()
+  (:metaclass smoke::smoke-wrapper-class))
+
+;; FIXME 5am prevents garbage collection!?
+;; use eval !?
+(defun run-gc-child ()
+  (let ((objects nil))
+    (dotimes (x 10)
+      (let ((object (make-instance 'qt:object)))
+        (make-instance 'qt:object :args (list object))
+        ;(cxx:set-parent (make-instance 'qt:object) object)
+        (push object objects)))
+    (gc :full t)))
+
+(defun run-gc-my-child ()
+  (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)))
+  
+  
+(5am:test (gc-child :depends-on gc-qobject)
+  "Test garbage collection of a qt:object with a parent."
+  (gc :full t)
+  (let ((count (hash-table-count smoke::*object-map*)))
+    (eval '(run-gc-child))
+    (gc :full t)
+    (gc :full t)
+    (5am:is (= count (hash-table-count smoke::*object-map*)))))
+
+(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
+    (let ((count (hash-table-count smoke::*object-map*)))
+      (eval '(run-gc-my-child))
+      (gc :full t)
+      (qt:core-application.send-posted-events)
+      (gc :full t)
+      (qt:core-application.send-posted-events)
+      (5am:is (= count (hash-table-count smoke::*object-map*))))))
diff -rN -u old-qt.tests/src/overload.lisp new-qt.tests/src/overload.lisp
--- old-qt.tests/src/overload.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/overload.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,23 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(defclass my-object (qt:object)
+  ((counter :accessor counter :initform 0))
+  (:metaclass smoke::smoke-wrapper-class))
+
+(defmethod cxx:timer-event ((object my-object) &rest args)
+  (declare (ignore args))
+  (format t "TIME~%")
+  (incf (counter object)))
+  
+
+;;FIXME
+#|(5am:test timer
+  (let ((object (make-instance 'my-object)))
+    (qt:init-app)
+    (5am:is (= 0 (counter object)))
+    (cxx:starttimer object 50)
+    (sleep 3)
+    (5am:is (= 1 (counter object)))))
+|#
diff -rN -u old-qt.tests/src/package.lisp new-qt.tests/src/package.lisp
--- old-qt.tests/src/package.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/package.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,3 @@
+(defpackage :qt.tests
+  (:use :cl :asdf :trivial-garbage :bordeaux-threads)
+  (:export :run))
diff -rN -u old-qt.tests/src/properties.lisp new-qt.tests/src/properties.lisp
--- old-qt.tests/src/properties.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/properties.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,31 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+;(5am:test property-list
+;  "Test properties"
+;  (5am:is (= 0 (length (qt:class-properties (find-class 'qt:object)))))
+;  (5am:is (= 1 (length (qt:properties (make-instance 'qt:object))))))
+
+(5am:test (property :depends-on qstring)
+  "Tests get and set property string"
+  (let ((o (make-instance 'qt:object)))
+    (5am:is (eql t (qt:property-p o "objectName")))
+    (5am:is (eql t (qt:property-p o 'object-name)))
+
+    (setf (qt:property o 'object-name) "fooBar")
+    (5am:is (string= (qt:property o 'object-name) "fooBar"))
+    (5am:is (string= (qt:property o "objectName") "fooBar"))
+    
+    (5am:is (eql nil (qt:property-p o 'foo)))
+    (setf (qt:property o 'foo) "bar")
+    (5am:is (eql t (qt:property-p o 'foo)))
+    (5am:is (string= (qt:property o 'foo) "bar"))))
+    
+
+(5am:test property-int
+  "Test get and set property integer"
+  (let ((o (make-instance 'qt:object)))
+    (5am:for-all ((integer (5am:gen-integer)))
+      (setf (qt:property o 'foo-bar) integer)
+      (5am:is (= integer (qt:property o 'foo-bar))))))
diff -rN -u old-qt.tests/src/qbytearray.lisp new-qt.tests/src/qbytearray.lisp
--- old-qt.tests/src/qbytearray.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/qbytearray.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,17 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+
+(5am:test null-bytearray
+  "Test empty QByteArray."
+  (5am:is (string= ""
+                   (cxx:data (make-instance 'qt:byte-array)))))
+
+
+(5am:test make-bytearray 
+  "Tests string <-> QByteArray."
+  (5am:for-all ((string (5am:gen-string)))
+    (5am:is (string= string
+                     (cxx:data (make-instance 'qt:byte-array
+                                              :args (list string)))))))
diff -rN -u old-qt.tests/src/qstring.lisp new-qt.tests/src/qstring.lisp
--- old-qt.tests/src/qstring.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/qstring.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,24 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(5am:test qstring
+  "Tests string <-> QString."
+  (let ((object (make-instance 'qt:object)))
+;    (5am:for-all ((string (5am:gen-string))) ;;FIXME
+    (5am:for-all ((string (5am:gen-one-element "foo"
+                                              "FOO bar"
+                                              (format nil "A~AB" #\Null)
+                                              "öäü")))
+      (cxx:set-object-name object string)
+      (5am:is (string= string (cxx:object-name object))))))
+
+(5am:test (string-list :depends-on qstring)
+  "Test vector <-> QStringList."
+  (5am:for-all ((vector (5am:gen-one-element #()
+                                             #("foo")
+                                             #("foo" "bar")
+                                             #("ä" "ö" "ü"))))
+    (let ((model (make-instance 'qt:string-list-model
+                                :args (list vector))))
+      (5am:is (equalp vector (cxx:string-list model))))))
diff -rN -u old-qt.tests/src/signal-slot.lisp new-qt.tests/src/signal-slot.lisp
--- old-qt.tests/src/signal-slot.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/signal-slot.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,121 @@
+(in-package :qt.tests)
+(declaim (optimize (debug 3)))
+
+(5am:in-suite :qt.suite)
+
+(5am:test simple-signal-slot
+  "Test custom signal to custom slot connection."
+  (let ((counter 0))
+    (let ((my-signal (make-instance 'qt:qsignal))
+          (my-slot (qt::make-slot #'(lambda () (incf counter))
+                                  nil)))
+                                    
+      (qt:connect my-signal my-slot)
+      (funcall my-signal)
+      (5am:is (= 1 counter)))))
+
+(5am:test (emit-int-signal :depends-on with-app)
+  "Emits a signal with a C++ integer argument to a C++ slot."
+  (qt:with-core-app
+    (let ((my-signal (qt:make-signal))
+          (label (make-instance 'qt:label)))
+      (qt:connect my-signal (qt:get-slot label "setNum(int)"))
+      (5am:for-all ((number (5am:gen-integer)))
+        (funcall my-signal number)
+        (5am:is (eql number (read-from-string (cxx:text label))))))))
+
+(5am:test (emit-float-signal :depends-on with-app)
+  "Emits a signal with a C++ integer argument to a C++ slot."
+  (qt:with-core-app
+    (let ((my-signal (qt:make-signal))
+          (label (make-instance 'qt:label)))
+      (qt:connect my-signal (qt:get-slot label "setNum(double)"))
+      (5am:for-all ((number (5am:gen-float :bound 100 
+                                           :type 'double-float)))
+        (funcall my-signal number)
+        (5am:is (< (abs (- number (read-from-string (cxx:text label))))
+                   0.001))))))
+
+(5am:test emit-bool-signal
+  "Emits a signal with an boolean C++ argument to a C++ slot."
+  (qt:with-app
+    (let ((my-signal (qt:make-signal))
+          (widget (make-instance 'qt:check-box)))
+      (qt:connect my-signal (qt:get-slot widget "setChecked(bool)"))
+      (5am:for-all ((enable (5am:gen-one-element t nil)))
+        (funcall my-signal enable)
+        (5am:is (eql enable (cxx:is-checked widget)))))))
+
+
+(5am:test (emit-qstring-signal :depends-on (and qstring with-app))
+  "Emits a signal with a C++ QString argument to a C++ slot."
+  (qt:with-app
+    (let ((my-signal (qt:make-signal))
+          (widget (make-instance 'qt:widget)))
+      (qt:connect my-signal (qt:get-slot widget "setWindowTitle(QString)"))
+
+      ;;    (5am:for-all ((title (5am:gen-string)))
+      ;; FIXME fails for gen-string (some UTF-8 problem?)
+      (5am:for-all ((title (5am:gen-one-element "foo" "FooBar" "öäü")))
+        (funcall my-signal title)
+        (5am:is (string= title (cxx:window-title widget)))))))
+
+;; FIXME in reality the lisp wrapper object get passed.
+(5am:test (arg-signal-slot :depends-on simple-signal-slot)
+  "Passing an C++ class as argument to an slot."
+  (let ((size nil))
+    (let ((my-signal (qt:make-signal))
+          (my-slot (qt:make-slot #'(lambda (s)
+                                     (5am:is (typep s (find-class 'qt:size)))
+                                     (setf size (cons (cxx:width s)
+                                                      (cxx:height s))))
+                                 (list (find-class 'qt:size)))))
+      (qt:connect my-signal my-slot)
+      (funcall my-signal (make-instance 'qt:size :args '(3 7)))
+      (5am:is (= 3 (first size)))
+      (5am:is (= 7 (rest size))))))
+
+
+(5am:test (lisp-arg-signal-slot :depends-on simple-signal-slot)
+  "Pass a lisp object over a signal-slot connection."
+  (let ((num 1d0)
+        (ret nil))
+    (let ((my-signal (qt:make-signal (find-class 'double-float)))
+          (my-slot (qt:make-slot #'(lambda (d)
+                                     (5am:is (eq d num))
+                                     (setf ret d))
+                                 (list (find-class 'double-float)))))
+      (qt:connect my-signal my-slot)
+      (funcall my-signal num))
+    (5am:is (eq ret num))))
+
+(5am:test (lisp-two-arg-signal-slot :depends-on lisp-arg-signal-slot)
+  "Pass a lisp object over a signal-slot connection."
+  (let ((num 1d0)
+        (count 0))
+    (let ((my-signal (make-instance 'qt:qsignal))
+          (my-slot (qt::make-slot #'(lambda (a b)
+                                      (5am:is (eq a num))
+                                      (5am:is (eql t b))
+                                      (incf count))
+                                  (mapcar #'find-class '(double-float t)))))
+      (qt:connect my-signal my-slot)
+      (funcall my-signal num t))
+    (5am:is (= 1 count))))
+
+(defparameter *destroyed* nil)
+
+(defun test-destroyed-signal ()
+  (let ((object (make-instance 'qt:object)))
+    (qt:connect (qt:get-signal object "destroyed()")
+                #'(lambda () (setf *destroyed* t)))
+    (sb-ext:gc :full t)
+    (5am:is (eql nil *destroyed*)))
+  (sb-ext:gc :full t))
+
+(5am:test (destroyed-signal :depends-on gc-qobject)
+  "Receive a destroy signal for a QObject."
+  (setf *destroyed* nil)
+  (test-destroyed-signal)
+  (sb-ext:gc :full t)
+  (5am:is (eql t *destroyed*)))
diff -rN -u old-qt.tests/src/tests.lisp new-qt.tests/src/tests.lisp
--- old-qt.tests/src/tests.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/tests.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,13 @@
+(in-package :qt.tests)
+
+(5am:def-suite :qt.suite :description "Qt tests")
+
+(5am:in-suite :qt.suite)
+
+(defun run ()
+;  (let ((5am:*debug-on-failure* t)
+;        (5am:*debug-on-error* t))
+  (let ((results (5am:run :qt.suite)))
+    (5am:explain! results)
+    (unless (5am:results-status results)
+      (error "Testsuite :qt.suite failed."))))
diff -rN -u old-qt.tests/src/thread.lisp new-qt.tests/src/thread.lisp
--- old-qt.tests/src/thread.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/thread.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,40 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+;;; FIXME implement something sensibel and test
+;;;  that it realy tests for races.
+
+
+(defmacro parallel-test (&body body)
+  "Executes BODY concurrently by using threads and tests
+wherther all tests are successfull."
+  (let ((threads (gensym))
+        (thread (gensym)))
+    `(let ((,threads nil))
+       (with-timeout (5)
+         (dotimes (,(gensym) 2)
+           (push (make-thread #'(lambda () ,@body))
+                 ,threads))
+         (dolist (,thread ,threads)
+           (5am:is (eql (5am:results-status (join-thread ,thread))
+                        t)))))))
+
+#|
+(5am:test (bytearray-threads :depends-on make-bytearray)
+  "Concurrent qbytearray creation."
+  (parallel-test
+    (dotimes (x 5)
+      (5am:run 'make-bytearray))))
+      |#
+
+;; FIXME this test does not work realibly
+#|
+(5am:test (gc-object-threads :depends-on gc-object)
+  "Concurrent garbage collenction."
+  (parallel-test
+    (dotimes (x 2)
+      (5am:run 'gc-object))))
+
+
+|#
diff -rN -u old-qt.tests/src/variant.lisp new-qt.tests/src/variant.lisp
--- old-qt.tests/src/variant.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/variant.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,22 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(5am:test (variant-string :depends-on qstring)
+  "Test qt:variant <-> string conversion."
+;  (5am:for-all ((string (5am:gen-string)))
+  (5am:for-all ((string (5am:gen-one-element "foo"
+                                            "Foo Bar")))
+    (5am:is (string= string (qt:from-variant (qt:make-variant string))))))
+
+(5am:test variant-int
+  "Test qt:variant <-> string conversion."
+  (5am:for-all ((integer (5am:gen-integer)))
+    (5am:is (= integer (qt:from-variant (qt:make-variant integer))))))
+
+(5am:test lisp-variant
+  "Test qt:variant <-> lisp object conversion."
+  (5am:for-all ((object (5am:gen-one-element #(1 2 3)
+                                             (list "foo" "bar"))))
+    (5am:is (eq object (qt:from-variant (qt:make-lisp-variant object))))))
+    
diff -rN -u old-qt.tests/tests/test.lisp new-qt.tests/tests/test.lisp
--- old-qt.tests/tests/test.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/tests/test.lisp	2014-10-30 07:59:34.000000000 +0100
@@ -0,0 +1,3 @@
+(in-package :qt.tests)
+
+(run)