repos
/
qt.tests
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Test argument conversion/promotion when emiting signals
Annotate for file src/signal-slot.lisp
2009-04-02 tobias
1
(in-package :qt.tests)
2009-06-11 tobias
2
(declaim (optimize (debug 3)))
2009-04-02 tobias
3
22:17:02 '
4
(5am:in-suite :qt.suite)
'
5
'
6
(5am:test simple-signal-slot
'
7
"Test custom signal to custom slot connection."
'
8
(let ((counter 0))
2009-06-11 tobias
9
(let ((my-signal (make-instance 'qt:qsignal))
2009-04-02 tobias
10
(my-slot (qt::make-slot #'(lambda () (incf counter))
22:17:02 '
11
nil)))
2009-07-01 tobias
12
2009-04-02 tobias
13
(qt:connect my-signal my-slot)
22:17:02 '
14
(funcall my-signal)
'
15
(5am:is (= 1 counter)))))
'
16
'
17
(5am:test (emit-int-signal :depends-on with-app)
'
18
"Emits a signal with a C++ integer argument to a C++ slot."
2009-07-01 tobias
19
(qt:with-core-app
2009-04-02 tobias
20
(let ((my-signal (qt:make-signal))
22:17:02 '
21
(label (make-instance 'qt:label)))
'
22
(qt:connect my-signal (qt:get-slot label "setNum(int)"))
'
23
(5am:for-all ((number (5am:gen-integer)))
'
24
(funcall my-signal number)
'
25
(5am:is (eql number (read-from-string (cxx:text label))))))))
'
26
'
27
(5am:test (emit-float-signal :depends-on with-app)
'
28
"Emits a signal with a C++ integer argument to a C++ slot."
2009-07-01 tobias
29
(qt:with-core-app
2009-04-02 tobias
30
(let ((my-signal (qt:make-signal))
22:17:02 '
31
(label (make-instance 'qt:label)))
'
32
(qt:connect my-signal (qt:get-slot label "setNum(double)"))
'
33
(5am:for-all ((number (5am:gen-float :bound 100
'
34
:type 'double-float)))
'
35
(funcall my-signal number)
'
36
(5am:is (< (abs (- number (read-from-string (cxx:text label))))
'
37
0.001))))))
'
38
'
39
(5am:test emit-bool-signal
'
40
"Emits a signal with an boolean C++ argument to a C++ slot."
2009-07-01 tobias
41
(qt:with-app
2009-04-02 tobias
42
(let ((my-signal (qt:make-signal))
22:17:02 '
43
(widget (make-instance 'qt:check-box)))
'
44
(qt:connect my-signal (qt:get-slot widget "setChecked(bool)"))
'
45
(5am:for-all ((enable (5am:gen-one-element t nil)))
'
46
(funcall my-signal enable)
'
47
(5am:is (eql enable (cxx:is-checked widget)))))))
'
48
'
49
'
50
(5am:test (emit-qstring-signal :depends-on (and qstring with-app))
'
51
"Emits a signal with a C++ QString argument to a C++ slot."
2009-07-01 tobias
52
(qt:with-app
2009-04-02 tobias
53
(let ((my-signal (qt:make-signal))
22:17:02 '
54
(widget (make-instance 'qt:widget)))
'
55
(qt:connect my-signal (qt:get-slot widget "setWindowTitle(QString)"))
'
56
'
57
;; (5am:for-all ((title (5am:gen-string)))
'
58
;; FIXME fails for gen-string (some UTF-8 problem?)
'
59
(5am:for-all ((title (5am:gen-one-element "foo" "FooBar" "öäü")))
'
60
(funcall my-signal title)
'
61
(5am:is (string= title (cxx:window-title widget)))))))
'
62
'
63
;; FIXME in reality the lisp wrapper object get passed.
'
64
(5am:test (arg-signal-slot :depends-on simple-signal-slot)
'
65
"Passing an C++ class as argument to an slot."
'
66
(let ((size nil))
'
67
(let ((my-signal (qt:make-signal))
'
68
(my-slot (qt:make-slot #'(lambda (s)
'
69
(5am:is (typep s (find-class 'qt:size)))
'
70
(setf size (cons (cxx:width s)
'
71
(cxx:height s))))
'
72
(list (find-class 'qt:size)))))
'
73
(qt:connect my-signal my-slot)
'
74
(funcall my-signal (make-instance 'qt:size :args '(3 7)))
'
75
(5am:is (= 3 (first size)))
'
76
(5am:is (= 7 (rest size))))))
'
77
'
78
'
79
(5am:test (lisp-arg-signal-slot :depends-on simple-signal-slot)
'
80
"Pass a lisp object over a signal-slot connection."
'
81
(let ((num 1d0)
'
82
(ret nil))
'
83
(let ((my-signal (qt:make-signal (find-class 'double-float)))
'
84
(my-slot (qt:make-slot #'(lambda (d)
'
85
(5am:is (eq d num))
'
86
(setf ret d))
'
87
(list (find-class 'double-float)))))
'
88
(qt:connect my-signal my-slot)
'
89
(funcall my-signal num))
'
90
(5am:is (eq ret num))))
'
91
'
92
(5am:test (lisp-two-arg-signal-slot :depends-on lisp-arg-signal-slot)
'
93
"Pass a lisp object over a signal-slot connection."
'
94
(let ((num 1d0)
'
95
(count 0))
2009-06-11 tobias
96
(let ((my-signal (make-instance 'qt:qsignal))
2009-04-02 tobias
97
(my-slot (qt::make-slot #'(lambda (a b)
22:17:02 '
98
(5am:is (eq a num))
'
99
(5am:is (eql t b))
'
100
(incf count))
'
101
(mapcar #'find-class '(double-float t)))))
'
102
(qt:connect my-signal my-slot)
'
103
(funcall my-signal num t))
'
104
(5am:is (= 1 count))))
'
105
'
106
(defparameter *destroyed* nil)
'
107
'
108
(defun test-destroyed-signal ()
'
109
(let ((object (make-instance 'qt:object)))
'
110
(qt:connect (qt:get-signal object "destroyed()")
'
111
#'(lambda () (setf *destroyed* t)))
2009-04-07 tobias
112
(tg:gc :full t)
2009-04-12 tobias
113
(5am:is (eq nil *destroyed*)))
2009-04-07 tobias
114
(tg:gc :full t))
2009-04-02 tobias
115
22:17:02 '
116
(5am:test (destroyed-signal :depends-on gc-qobject)
'
117
"Receive a destroy signal for a QObject."
'
118
(setf *destroyed* nil)
2009-04-12 tobias
119
(eval '(test-destroyed-signal)) ;; FIXME eval somehow makes gc in 5am work!?
14:45:00 '
120
(eval '(tg:gc :full t))
2009-04-07 tobias
121
(tg:gc :full t)
2009-04-12 tobias
122
(5am:is (eq t *destroyed*)))
2009-04-08 tobias
123
(5am:test int-signal
15:10:42 '
124
"Receive a int signal."
2009-07-01 tobias
125
(qt:with-app
11:02:20 '
126
(let ((spin-box (make-instance 'qt:spin-box))
'
127
(current-value)
'
128
(current-string-value))
'
129
(qt:connect (qt:get-signal spin-box "valueChanged(int)")
'
130
#'(lambda (value)
'
131
(setf current-value value)))
'
132
(qt:connect (qt:get-signal spin-box "valueChanged(const QString&)")
'
133
#'(lambda (value)
'
134
(setf current-string-value value)))
'
135
(5am:for-all ((value (5am:gen-integer
'
136
:min (cxx:minimum spin-box)
'
137
:max (cxx:maximum spin-box))))
'
138
(cxx:set-value spin-box value)
'
139
(5am:is (= value current-value))
'
140
(5am:is (= value (read-from-string current-string-value)))))))
2009-04-08 tobias
141
15:10:42 '
142
(5am:test object-signal
2009-04-08 tobias
143
"Receive a qt:object pointer signal."
2009-07-01 tobias
144
(qt:with-app
11:02:20 '
145
(let ((button (make-instance 'qt:push-button))
'
146
(click-count 0)
'
147
(signal-mapper (make-instance 'qt:signal-mapper)))
'
148
(qt:connect (qt:get-signal button "clicked()")
'
149
(qt:get-slot signal-mapper "map()"))
'
150
(cxx:set-mapping signal-mapper button button)
'
151
'
152
(qt:connect (qt:get-signal signal-mapper "mapped(QObject*)")
'
153
#'(lambda (object)
'
154
(5am:is (eq button object))
'
155
(incf click-count)))
'
156
(5am:is (= 0 click-count))
2009-06-11 tobias
157
(qt.test:test.mouse-click button qt:+left-button+)
2009-07-01 tobias
158
(5am:is (= 1 click-count)))))
2009-04-08 tobias
159
2009-04-08 tobias
160
(5am:test receive-by-value
22:37:07 '
161
"Receive a C++ class by value signal."
2009-07-01 tobias
162
(qt:with-app
2009-04-08 tobias
163
(let ((model (make-instance 'qt:string-list-model))
2009-04-12 tobias
164
(count 0))
2009-04-08 tobias
165
(qt:connect (qt:get-signal model
22:37:07 '
166
"rowsInserted(QModelIndex, int, int)")
'
167
#'(lambda (parent start end)
2009-04-12 tobias
168
(5am:is (cxx:= (cxx:parent (cxx:index model start)))
2009-07-01 tobias
169
parent)
2009-04-08 tobias
170
(incf count)))
22:37:07 '
171
(5am:is (= 0 count))
'
172
(cxx:insert-rows model 0 1)
'
173
(5am:is (= 1 count))
'
174
(cxx:insert-rows model 0 3)
'
175
(5am:is (= 2 count)))))
2009-04-08 tobias
176
2009-05-26 tobias
177
(5am:test (emit-user-conversion :depends-on emit-qstring-signal)
09:59:49 '
178
"Emit a signal with a user conversion of the argument."
'
179
(qt:with-app
'
180
(let ((combobox (make-instance 'qt:text-edit))
'
181
(set-font (qt:make-signal)))
'
182
(qt:connect set-font
'
183
(qt:get-slot combobox "setCurrentFont(QFont)"))
'
184
(5am:is (cxx:operator== (cxx:current-font combobox)
'
185
(make-instance 'qt:font)))
'
186
(funcall set-font "Times")
'
187
(5am:is (cxx:operator== (cxx:current-font combobox)
'
188
"Times")))))
'
189