repos
/
qt.tests
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
ASDF & modular smoke.
Annotate for file /src/signal-slot.lisp
2009-04-02 tobias
1
(in-package :qt.tests)
22:17:02 '
2
'
3
(5am:in-suite :qt.suite)
'
4
'
5
(5am:test simple-signal-slot
'
6
"Test custom signal to custom slot connection."
'
7
(let ((counter 0))
2009-06-11 tobias
8
(let ((my-signal (qt:make-signal))
2009-04-02 tobias
9
(my-slot (qt::make-slot #'(lambda () (incf counter))
22:17:02 '
10
nil)))
2009-07-01 tobias
11
2009-04-02 tobias
12
(qt:connect my-signal my-slot)
22:17:02 '
13
(funcall my-signal)
'
14
(5am:is (= 1 counter)))))
'
15
'
16
(5am:test (emit-int-signal :depends-on with-app)
'
17
"Emits a signal with a C++ integer argument to a C++ slot."
2010-01-10 tobias
18
(qt:with-app ()
2009-04-02 tobias
19
(let ((my-signal (qt:make-signal))
22:17:02 '
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))))))))
'
25
'
26
(5am:test (emit-float-signal :depends-on with-app)
'
27
"Emits a signal with a C++ integer argument to a C++ slot."
2010-01-10 tobias
28
(qt:with-app ()
2009-04-02 tobias
29
(let ((my-signal (qt:make-signal))
22:17:02 '
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))))
'
36
0.001))))))
'
37
'
38
(5am:test emit-bool-signal
'
39
"Emits a signal with an boolean C++ argument to a C++ slot."
2009-07-01 tobias
40
(qt:with-app ()
2009-04-02 tobias
41
(let ((my-signal (qt:make-signal))
22:17:02 '
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)))))))
'
47
'
48
'
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."
2009-07-01 tobias
51
(qt:with-app ()
2009-04-02 tobias
52
(let ((my-signal (qt:make-signal))
22:17:02 '
53
(widget (make-instance 'qt:widget)))
'
54
(qt:connect my-signal (qt:get-slot widget "setWindowTitle(QString)"))
'
55
'
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)))))))
'
61
'
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."
'
65
(let ((size nil))
'
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)
'
70
(cxx:height 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))))))
'
76
'
77
'
78
(5am:test (lisp-arg-signal-slot :depends-on simple-signal-slot)
'
79
"Pass a lisp object over a signal-slot connection."
'
80
(let ((num 1d0)
'
81
(ret nil))
'
82
(let ((my-signal (qt:make-signal (find-class 'double-float)))
'
83
(my-slot (qt:make-slot #'(lambda (d)
'
84
(5am:is (eq d num))
'
85
(setf ret 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))))
'
90
'
91
(5am:test (lisp-two-arg-signal-slot :depends-on lisp-arg-signal-slot)
'
92
"Pass a lisp object over a signal-slot connection."
'
93
(let ((num 1d0)
'
94
(count 0))
2009-06-11 tobias
95
(let ((my-signal (qt:make-signal))
2009-04-02 tobias
96
(my-slot (qt::make-slot #'(lambda (a b)
22:17:02 '
97
(5am:is (eq a num))
'
98
(5am:is (eql t b))
'
99
(incf count))
'
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))))
'
104
'
105
(defparameter *destroyed* nil)
'
106
'
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)))
2009-04-07 tobias
111
(tg:gc :full t)
2009-04-12 tobias
112
(5am:is (eq nil *destroyed*)))
2009-04-07 tobias
113
(tg:gc :full t))
2009-04-02 tobias
114
2009-06-10 tobias
115
;; SBCL runs the finalizer when the object has been garbage collected,
12:09:14 '
116
;; thus its children could be to and thus the destroyed() signal is not
'
117
;; received
2009-06-30 tobias
118
#-(or sbcl cmucl ccl)
2009-04-02 tobias
119
(5am:test (destroyed-signal :depends-on gc-qobject)
22:17:02 '
120
"Receive a destroy signal for a QObject."
'
121
(setf *destroyed* nil)
2009-04-12 tobias
122
(eval '(test-destroyed-signal)) ;; FIXME eval somehow makes gc in 5am work!?
14:45:00 '
123
(eval '(tg:gc :full t))
2009-04-07 tobias
124
(tg:gc :full t)
2009-04-12 tobias
125
(5am:is (eq t *destroyed*)))
2009-04-08 tobias
126
(5am:test int-signal
15:10:42 '
127
"Receive a int signal."
2009-07-01 tobias
128
(qt:with-app ()
11:02:20 '
129
(let ((spin-box (make-instance 'qt:spin-box))
'
130
(current-value)
'
131
(current-string-value))
'
132
(qt:connect (qt:get-signal spin-box "valueChanged(int)")
'
133
#'(lambda (value)
'
134
(setf current-value value)))
'
135
(qt:connect (qt:get-signal spin-box "valueChanged(const QString&)")
'
136
#'(lambda (value)
'
137
(setf current-string-value value)))
'
138
(5am:for-all ((value (5am:gen-integer
'
139
:min (cxx:minimum spin-box)
'
140
:max (cxx:maximum spin-box))))
'
141
(cxx:set-value spin-box value)
'
142
(5am:is (= value current-value))
'
143
(5am:is (= value (read-from-string current-string-value)))))))
2009-04-08 tobias
144
15:10:42 '
145
(5am:test object-signal
2009-04-08 tobias
146
"Receive a qt:object pointer signal."
2009-07-01 tobias
147
(qt:with-app ()
11:02:20 '
148
(let ((button (make-instance 'qt:push-button))
'
149
(click-count 0)
'
150
(signal-mapper (make-instance 'qt:signal-mapper)))
'
151
(qt:connect (qt:get-signal button "clicked()")
'
152
(qt:get-slot signal-mapper "map()"))
'
153
(cxx:set-mapping signal-mapper button button)
2009-08-27 tobias
154
;; button is a QWidget thus it's mapped(QWidget*) and not
08:41:11 '
155
;; mapped(QObject*)
'
156
(qt:connect (qt:get-signal signal-mapper "mapped(QWidget*)")
2009-07-01 tobias
157
#'(lambda (object)
11:02:20 '
158
(5am:is (eq button object))
'
159
(incf click-count)))
'
160
(5am:is (= 0 click-count))
2009-08-27 tobias
161
(qt:test.mouse-click button qt:+left-button+
08:41:11 '
162
0 (make-instance 'qt:point) -1)
2009-07-01 tobias
163
(5am:is (= 1 click-count)))))
2009-04-08 tobias
164
2009-04-08 tobias
165
(5am:test receive-by-value
22:37:07 '
166
"Receive a C++ class by value signal."
2009-07-01 tobias
167
(qt:with-app ()
2009-04-08 tobias
168
(let ((model (make-instance 'qt:string-list-model))
2009-04-12 tobias
169
(count 0))
2009-04-08 tobias
170
(qt:connect (qt:get-signal model
22:37:07 '
171
"rowsInserted(QModelIndex, int, int)")
'
172
#'(lambda (parent start end)
2009-07-01 tobias
173
(declare (ignore end))
2009-04-12 tobias
174
(5am:is (cxx:= (cxx:parent (cxx:index model start)))
2009-07-01 tobias
175
parent)
2009-04-08 tobias
176
(incf count)))
22:37:07 '
177
(5am:is (= 0 count))
'
178
(cxx:insert-rows model 0 1)
'
179
(5am:is (= 1 count))
'
180
(cxx:insert-rows model 0 3)
'
181
(5am:is (= 2 count)))))
2009-04-08 tobias
182
2009-05-26 tobias
183
(5am:test (emit-user-conversion :depends-on emit-qstring-signal)
09:59:49 '
184
"Emit a signal with a user conversion of the argument."
2009-07-01 tobias
185
(qt:with-app ()
11:02:20 '
186
(let ((combobox (make-instance 'qt:text-edit))
'
187
(set-font (qt:make-signal)))
'
188
(qt:connect set-font
'
189
(qt:get-slot combobox "setCurrentFont(QFont)"))
'
190
(5am:is (cxx:operator== (cxx:current-font combobox)
'
191
(make-instance 'qt:font)))
'
192
(funcall set-font "Times")
'
193
(5am:is (cxx:operator== (cxx:current-font combobox)
'
194
"Times")))))
2009-05-26 tobias
195