src/signal-slot.lisp
Fri Apr 3 00:17:02 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* initial import
--- 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:51.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*)))