repos
/
qt.tests
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
use trivial-garbage instead of sb-ext
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*)))