repos
/
commonqt
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Fix invalid keyword argument errors in defclass qt-class.
Annotate for file tests/test.lisp
2010-01-10 tobias
1
;;; Copyright (C) 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
2009-07-24 tobias
2
;;;
13:39:55 '
3
;;; This program is free software: you can redistribute it and/or modify
'
4
;;; it under the terms of the GNU General Public License as published by
'
5
;;; the Free Software Foundation, either version 3 of the License, or
'
6
;;; (at your option) any later version.
'
7
;;;
'
8
;;; This program is distributed in the hope that it will be useful,
'
9
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
'
10
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'
11
;;; GNU General Public License for more details.
'
12
;;;
'
13
;;; You should have received a copy of the GNU General Public License
'
14
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
'
15
;;;
'
16
;;; As a special exception, the copyright holders of this library give you
'
17
;;; permission to link this library with independent modules to produce an
'
18
;;; executable, regardless of the license terms of these independent
'
19
;;; modules, and to copy and distribute the resulting executable under
'
20
;;; terms of your choice, provided that you also meet, for each linked
'
21
;;; independent module, the terms and conditions of the license of that
'
22
;;; module. An independent module is a module which is not derived from or
'
23
;;; based on this library. If you modify this library, you may extend this
'
24
;;; exception to your version of the library, but you are not obligated to
'
25
;;; do so. If you do not wish to do so, delete this exception statement
'
26
;;; from your version.
'
27
2010-01-10 tobias
28
(eval-when (:compile-toplevel :load-toplevel)
08:53:29 '
29
(mb:load :FiveAM))
'
30
2009-07-02 tobias
31
(in-package :cl-smoke.commonqt)
17:34:07 '
32
'
33
(5am:def-suite :cl-smoke.commonqt-suite)
'
34
(5am:in-suite :cl-smoke.commonqt-suite)
'
35
'
36
(5am:test static-call
2009-07-24 tobias
37
"Test static method call."
2009-07-02 tobias
38
(5am:is (string= (cl-smoke.qt:q-version)
17:34:07 '
39
(#_qVersion "GlobalSpace"))))
'
40
'
41
(5am:test enum
2009-07-24 tobias
42
"Test enum access."
2009-07-02 tobias
43
(5am:is (enum= cl-smoke.qt:+blue+
2009-07-02 tobias
44
(#_blue "Qt")))
20:48:38 '
45
(5am:is (enum= cl-smoke.qt:font.+bold+
'
46
(#_Bold "Font")))
'
47
(5am:is (enum= cl-smoke.qt:+key-enter+
'
48
(#_Key_Enter "Qt"))))
2009-07-02 tobias
49
17:34:07 '
50
(5am:test new
2009-07-24 tobias
51
"Test allocating with #_new."
2009-07-02 tobias
52
(5am:is (cxx:= (make-instance 'cl-smoke.qt:byte-array :args '("foobar"))
17:34:07 '
53
(#_new QByteArray "foobar"))))
'
54
'
55
(5am:test call
2009-07-24 tobias
56
"Test #_ method calling."
2009-07-02 tobias
57
(let ((byte-array (make-instance 'cl-smoke.qt:byte-array :args '("foobar"))))
17:34:07 '
58
(5am:is (string= (cxx:data byte-array)
'
59
(#_data byte-array)))))
'
60
'
61
(defclass button ()
'
62
((called :accessor button-meta-object-called :initform nil))
'
63
(:metaclass qt-class)
'
64
(:qt-superclass "QPushButton")
'
65
(:override ("metaObject" meta-object)))
'
66
'
67
(defmethod initialize-instance :after ((instance button) &rest initargs)
'
68
(declare (ignore initargs))
'
69
(new instance "foobar"))
'
70
'
71
(defmethod meta-object ((this button))
'
72
(setf (button-meta-object-called this) t)
'
73
(call-next-qmethod))
'
74
'
75
(5am:test subclassing
'
76
(cl-smoke.qt:with-app ()
'
77
(let ((button (make-instance 'button)))
'
78
(5am:is (string= ""
'
79
(#_objectName button)))
'
80
(5am:is (string= "foobar"
'
81
(#_text button))))))
'
82
'
83
(5am:test overriding
2009-07-24 tobias
84
"Test overriding a virtual method."
2009-07-02 tobias
85
(cl-smoke.qt:with-app ()
17:34:07 '
86
(let ((button (make-instance 'button)))
'
87
(5am:is (eql nil (button-meta-object-called button)))
'
88
(#_metaObject button)
'
89
(5am:is (eql t (button-meta-object-called button))))))
'
90
'
91
(defclass mumble ()
'
92
((called :accessor mumble-called :initform nil))
'
93
(:metaclass qt-class)
'
94
(:qt-superclass "QObject")
2010-01-10 tobias
95
(:slots ("listen(int)" (lambda (this &optional value)
2009-07-02 tobias
96
(5am:is (= 37 value))
17:34:07 '
97
(setf (mumble-called this) t))))
2009-07-02 tobias
98
(:signals ("say(int)") ("think(int)")))
2009-07-02 tobias
99
17:34:07 '
100
(defmethod initialize-instance :after ((instance mumble) &rest initargs)
'
101
(declare (ignore initargs))
'
102
(new instance))
'
103
'
104
(5am:test signal-slot
2009-07-24 tobias
105
"Test signal to slot connection."
2009-07-02 tobias
106
(let ((mumble (make-instance 'mumble)))
17:34:07 '
107
(5am:is (eql t
'
108
(#_connect "QObject"
'
109
mumble (qt:qsignal "say(int)")
'
110
mumble (qt:qslot "listen(int)"))))
'
111
(5am:is (eql nil (mumble-called mumble)))
'
112
(emit-signal mumble "say(int)" 37)
'
113
(5am:is (eql t (mumble-called mumble)))
'
114
'
115
(5am:is (string= "QObject"
'
116
(#_className (#_superClass (#_metaObject mumble)))))))
'
117
2009-07-02 tobias
118
(5am:test (signal-signal :depends-on signal-slot)
2009-07-24 tobias
119
"Test signal to signal connection."
2009-07-02 tobias
120
(let ((mumble (make-instance 'mumble)))
21:49:43 '
121
(5am:is (eql t
'
122
(#_connect "QObject"
'
123
mumble (qt:qsignal "say(int)")
'
124
mumble (qt:qslot "listen(int)"))))
'
125
(5am:is (eql t
'
126
(#_connect "QObject"
'
127
mumble (qt:qsignal "think(int)")
'
128
mumble (qt:qsignal "say(int)"))))
'
129
(5am:is (eql nil (mumble-called mumble)))
'
130
(emit-signal mumble "think(int)" 37)
'
131
(5am:is (eql t (mumble-called mumble)))))
'
132
2009-07-02 tobias
133
(5am:test make-qapplication
2009-07-24 tobias
134
"Test QApplication creation with QT:MAKE-QAPPLICATION."
2009-07-02 tobias
135
(let ((application (make-qapplication)))
17:34:07 '
136
(5am:is (eql (#_instance "QCoreApplication")
'
137
application))
'
138
(5am:is (eql t (typep application 'cl-smoke.qt:application)))
'
139
(smoke:delete-object application)))
2009-07-24 tobias
140
13:39:55 '
141
(5am:test noops
'
142
(qt:ensure-smoke)
'
143
(qt:enable-syntax))
'
144
'
145
(5am:test docu
2009-08-27 tobias
146
(with-output-to-string (*standard-output*)
11:17:58 '
147
(qapropos "QObject")
'
148
(qdescribe "QObject")))
2009-07-24 tobias
149
2010-01-10 tobias
150
(eval-when (:load-toplevel)
2009-07-02 tobias
151
(let ((results (5am:run :cl-smoke.commonqt-suite)))
17:34:07 '
152
(5am:explain! results)
'
153
(unless (5am:results-status results)
2010-01-10 tobias
154
(error "Testsuite :qt.suite failed."))))