repos
/
qt.tests
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Test receiving C++ classes by value in a slot
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 (eql 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
(test-destroyed-signal)
2009-04-07 tobias
120
(tg:gc :full t)
2009-04-12 tobias
121
(5am:is (eql t *destroyed*)))
2009-04-08 tobias
122
(5am:test int-signal
15:10:42 '
123
"Receive a int signal."
2009-07-01 tobias
124
(qt:with-app
11:02:20 '
125
(let ((spin-box (make-instance 'qt:spin-box))
'
126
(current-value)
'
127
(current-string-value))
'
128
(qt:connect (qt:get-signal spin-box "valueChanged(int)")
'
129
#'(lambda (value)
'
130
(setf current-value value)))
'
131
(qt:connect (qt:get-signal spin-box "valueChanged(const QString&)")
'
132
#'(lambda (value)
'
133
(setf current-string-value value)))
'
134
(5am:for-all ((value (5am:gen-integer
'
135
:min (cxx:minimum spin-box)
'
136
:max (cxx:maximum spin-box))))
'
137
(cxx:set-value spin-box value)
'
138
(5am:is (= value current-value))
'
139
(5am:is (= value (read-from-string current-string-value)))))))
2009-04-08 tobias
140
15:10:42 '
141
(5am:test object-signal
2009-04-08 tobias
142
"Receive a qt:object pointer signal."
2009-07-01 tobias
143
(qt:with-app
11:02:20 '
144
(let ((button (make-instance 'qt:push-button))
'
145
(click-count 0)
'
146
(signal-mapper (make-instance 'qt:signal-mapper)))
'
147
(qt:connect (qt:get-signal button "clicked()")
'
148
(qt:get-slot signal-mapper "map()"))
'
149
(cxx:set-mapping signal-mapper button button)
'
150
'
151
(qt:connect (qt:get-signal signal-mapper "mapped(QObject*)")
'
152
#'(lambda (object)
2009-04-08 tobias
153
(5am:is (eq button object))
2009-07-01 tobias
154
(incf click-count)))
11:02:20 '
155
(5am:is (= 0 click-count))
2009-06-11 tobias
156
(qt.test:test.mouse-click button qt:+left-button+)
2009-07-01 tobias
157
(5am:is (= 1 click-count)))))
2009-04-08 tobias
158
2009-04-08 tobias
159
(5am:test receive-by-value
22:37:07 '
160
"Receive a C++ class by value signal."
'
161
(qt:with-app
'
162
(let ((model (make-instance 'qt:string-list-model))
'
163
(count 0))
'
164
(qt:connect (qt:get-signal model
'
165
"rowsInserted(QModelIndex, int, int)")
'
166
#'(lambda (parent start end)
'
167
(declare (ignore previous))
'
168
(5am:is (eq (cxx:internal-id (cxx:parent (cxx:index model start)))
'
169
(cxx:internal-id parent)))
'
170
(incf count)))
'
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