3 (5am:in-suite :qt.suite)
5 (5am:test simple-signal-slot
6 "Test custom signal to custom slot connection."
8 (let ((my-signal (qt:make-signal))
9 (my-slot (qt::make-slot #'(lambda () (incf counter))
12 (qt:connect my-signal my-slot)
14 (5am:is (= 1 counter)))))
16 (5am:test (emit-int-signal :depends-on with-app)
17 "Emits a signal with a C++ integer argument to a C++ slot."
19 (let ((my-signal (qt:make-signal))
20 (label (make-instance 'qt:label)))
21 (qt:connect my-signal (qt:get-slot label "setNum(int)"))
22 (5am:for-all ((number (5am:gen-integer)))
23 (funcall my-signal number)
24 (5am:is (eql number (read-from-string (cxx:text label))))))))
26 (5am:test (emit-float-signal :depends-on with-app)
27 "Emits a signal with a C++ integer argument to a C++ slot."
29 (let ((my-signal (qt:make-signal))
30 (label (make-instance 'qt:label)))
31 (qt:connect my-signal (qt:get-slot label "setNum(double)"))
32 (5am:for-all ((number (5am:gen-float :bound 100
33 :type 'double-float)))
34 (funcall my-signal number)
35 (5am:is (< (abs (- number (read-from-string (cxx:text label))))
38 (5am:test emit-bool-signal
39 "Emits a signal with an boolean C++ argument to a C++ slot."
41 (let ((my-signal (qt:make-signal))
42 (widget (make-instance 'qt:check-box)))
43 (qt:connect my-signal (qt:get-slot widget "setChecked(bool)"))
44 (5am:for-all ((enable (5am:gen-one-element t nil)))
45 (funcall my-signal enable)
46 (5am:is (eql enable (cxx:is-checked widget)))))))
49 (5am:test (emit-qstring-signal :depends-on (and qstring with-app))
50 "Emits a signal with a C++ QString argument to a C++ slot."
52 (let ((my-signal (qt:make-signal))
53 (widget (make-instance 'qt:widget)))
54 (qt:connect my-signal (qt:get-slot widget "setWindowTitle(QString)"))
56 ;; (5am:for-all ((title (5am:gen-string)))
57 ;; FIXME fails for gen-string (some UTF-8 problem?)
58 (5am:for-all ((title (5am:gen-one-element "foo" "FooBar" "öäü")))
59 (funcall my-signal title)
60 (5am:is (string= title (cxx:window-title widget)))))))
62 ;; FIXME in reality the lisp wrapper object get passed.
63 (5am:test (arg-signal-slot :depends-on simple-signal-slot)
64 "Passing an C++ class as argument to an slot."
66 (let ((my-signal (qt:make-signal))
67 (my-slot (qt:make-slot #'(lambda (s)
68 (5am:is (typep s (find-class 'qt:size)))
69 (setf size (cons (cxx:width s)
71 (list (find-class 'qt:size)))))
72 (qt:connect my-signal my-slot)
73 (funcall my-signal (make-instance 'qt:size :args '(3 7)))
74 (5am:is (= 3 (first size)))
75 (5am:is (= 7 (rest size))))))
78 (5am:test (lisp-arg-signal-slot :depends-on simple-signal-slot)
79 "Pass a lisp object over a signal-slot connection."
82 (let ((my-signal (qt:make-signal (find-class 'double-float)))
83 (my-slot (qt:make-slot #'(lambda (d)
86 (list (find-class 'double-float)))))
87 (qt:connect my-signal my-slot)
88 (funcall my-signal num))
89 (5am:is (eq ret num))))
91 (5am:test (lisp-two-arg-signal-slot :depends-on lisp-arg-signal-slot)
92 "Pass a lisp object over a signal-slot connection."
95 (let ((my-signal (qt:make-signal))
96 (my-slot (qt::make-slot #'(lambda (a b)
100 (mapcar #'find-class '(double-float t)))))
101 (qt:connect my-signal my-slot)
102 (funcall my-signal num t))
103 (5am:is (= 1 count))))
105 (defparameter *destroyed* nil)
107 (defun test-destroyed-signal ()
108 (let ((object (make-instance 'qt:object)))
109 (qt:connect (qt:get-signal object "destroyed()")
110 #'(lambda () (setf *destroyed* t)))
112 (5am:is (eq nil *destroyed*)))
115 ;; SBCL runs the finalizer when the object has been garbage collected,
116 ;; thus its children could be to and thus the destroyed() signal is not
118 #-(or sbcl cmucl ccl)
119 (5am:test (destroyed-signal :depends-on gc-qobject)
120 "Receive a destroy signal for a QObject."
121 (setf *destroyed* nil)
122 (eval '(test-destroyed-signal)) ;; FIXME eval somehow makes gc in 5am work!?
123 (eval '(tg:gc :full t))
125 (5am:is (eq t *destroyed*)))
128 "Receive a int signal."
130 (let ((spin-box (make-instance 'qt:spin-box))
132 (current-string-value))
133 (qt:connect (qt:get-signal spin-box "valueChanged(int)")
135 (setf current-value value)))
136 (qt:connect (qt:get-signal spin-box "valueChanged(const QString&)")
138 (setf current-string-value value)))
139 (5am:for-all ((value (5am:gen-integer
140 :min (cxx:minimum spin-box)
141 :max (cxx:maximum spin-box))))
142 (cxx:set-value spin-box value)
143 (5am:is (= value current-value))
144 (5am:is (= value (read-from-string current-string-value)))))))
146 (5am:test object-signal
147 "Receive a qt:object pointer signal."
149 (let ((button (make-instance 'qt:push-button))
151 (signal-mapper (make-instance 'qt:signal-mapper)))
152 (qt:connect (qt:get-signal button "clicked()")
153 (qt:get-slot signal-mapper "map()"))
154 (cxx:set-mapping signal-mapper button button)
155 ;; button is a QWidget thus it's mapped(QWidget*) and not
157 (qt:connect (qt:get-signal signal-mapper "mapped(QWidget*)")
159 (5am:is (eq button object))
161 (5am:is (= 0 click-count))
162 (qt:test.mouse-click button qt:+left-button+
163 0 (make-instance 'qt:point) -1)
164 (5am:is (= 1 click-count)))))
166 (5am:test receive-by-value
167 "Receive a C++ class by value signal."
169 (let ((model (make-instance 'qt:string-list-model))
171 (qt:connect (qt:get-signal model
172 "rowsInserted(QModelIndex, int, int)")
173 #'(lambda (parent start end)
174 (declare (ignore end))
175 (5am:is (cxx:= (cxx:parent (cxx:index model start)))
179 (cxx:insert-rows model 0 1)
181 (cxx:insert-rows model 0 3)
182 (5am:is (= 2 count)))))
184 (5am:test (emit-user-conversion :depends-on emit-qstring-signal)
185 "Emit a signal with a user conversion of the argument."
187 (let ((combobox (make-instance 'qt:text-edit))
188 (set-font (qt:make-signal)))
190 (qt:get-slot combobox "setCurrentFont(QFont)"))
191 (5am:is (cxx:operator== (cxx:current-font combobox)
192 (make-instance 'qt:font)))
193 (funcall set-font "Times")
194 (5am:is (cxx:operator== (cxx:current-font combobox)