repos
/
commonqt
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
modular smoke & test system.
Annotate for file /tests/test.lisp
2010-01-10 tobias
1
;;; Copyright (C) 2009, 2010 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
2009-07-02 tobias
28
(in-package :cl-smoke.commonqt)
17:34:07 '
29
'
30
(5am:def-suite :cl-smoke.commonqt-suite)
'
31
(5am:in-suite :cl-smoke.commonqt-suite)
2010-01-10 tobias
32
(declaim (optimize (debug 3)))
2009-07-02 tobias
33
17:34:07 '
34
(5am:test static-call
2009-07-24 tobias
35
"Test static method call."
2009-07-02 tobias
36
(5am:is (string= (cl-smoke.qt:q-version)
17:34:07 '
37
(#_qVersion "GlobalSpace"))))
'
38
'
39
(5am:test enum
2009-07-24 tobias
40
"Test enum access."
2009-07-02 tobias
41
(5am:is (enum= cl-smoke.qt:+blue+
2009-07-02 tobias
42
(#_blue "Qt")))
20:48:38 '
43
(5am:is (enum= cl-smoke.qt:font.+bold+
'
44
(#_Bold "Font")))
'
45
(5am:is (enum= cl-smoke.qt:+key-enter+
'
46
(#_Key_Enter "Qt"))))
2009-07-02 tobias
47
17:34:07 '
48
(5am:test new
2009-07-24 tobias
49
"Test allocating with #_new."
2009-07-02 tobias
50
(5am:is (cxx:= (make-instance 'cl-smoke.qt:byte-array :args '("foobar"))
17:34:07 '
51
(#_new QByteArray "foobar"))))
'
52
'
53
(5am:test call
2009-07-24 tobias
54
"Test #_ method calling."
2009-07-02 tobias
55
(let ((byte-array (make-instance 'cl-smoke.qt:byte-array :args '("foobar"))))
17:34:07 '
56
(5am:is (string= (cxx:data byte-array)
'
57
(#_data byte-array)))))
'
58
'
59
(defclass button ()
'
60
((called :accessor button-meta-object-called :initform nil))
'
61
(:metaclass qt-class)
'
62
(:qt-superclass "QPushButton")
'
63
(:override ("metaObject" meta-object)))
'
64
'
65
(defmethod initialize-instance :after ((instance button) &rest initargs)
'
66
(declare (ignore initargs))
'
67
(new instance "foobar"))
'
68
'
69
(defmethod meta-object ((this button))
'
70
(setf (button-meta-object-called this) t)
'
71
(call-next-qmethod))
'
72
'
73
(5am:test subclassing
'
74
(cl-smoke.qt:with-app ()
'
75
(let ((button (make-instance 'button)))
'
76
(5am:is (string= ""
'
77
(#_objectName button)))
'
78
(5am:is (string= "foobar"
'
79
(#_text button))))))
'
80
'
81
(5am:test overriding
2009-07-24 tobias
82
"Test overriding a virtual method."
2009-07-02 tobias
83
(cl-smoke.qt:with-app ()
17:34:07 '
84
(let ((button (make-instance 'button)))
'
85
(5am:is (eql nil (button-meta-object-called button)))
'
86
(#_metaObject button)
'
87
(5am:is (eql t (button-meta-object-called button))))))
'
88
'
89
(defclass mumble ()
'
90
((called :accessor mumble-called :initform nil))
'
91
(:metaclass qt-class)
'
92
(:qt-superclass "QObject")
2010-01-10 tobias
93
(:slots ("listen(int)" (lambda (this value)
2009-07-02 tobias
94
(5am:is (= 37 value))
17:34:07 '
95
(setf (mumble-called this) t))))
2009-07-02 tobias
96
(:signals ("say(int)") ("think(int)")))
2009-07-02 tobias
97
17:34:07 '
98
(defmethod initialize-instance :after ((instance mumble) &rest initargs)
'
99
(declare (ignore initargs))
'
100
(new instance))
'
101
'
102
(5am:test signal-slot
2009-07-24 tobias
103
"Test signal to slot connection."
2009-07-02 tobias
104
(let ((mumble (make-instance 'mumble)))
17:34:07 '
105
(5am:is (eql t
'
106
(#_connect "QObject"
'
107
mumble (qt:qsignal "say(int)")
'
108
mumble (qt:qslot "listen(int)"))))
'
109
(5am:is (eql nil (mumble-called mumble)))
'
110
(emit-signal mumble "say(int)" 37)
'
111
(5am:is (eql t (mumble-called mumble)))
'
112
'
113
(5am:is (string= "QObject"
'
114
(#_className (#_superClass (#_metaObject mumble)))))))
'
115
2009-07-02 tobias
116
(5am:test (signal-signal :depends-on signal-slot)
2009-07-24 tobias
117
"Test signal to signal connection."
2009-07-02 tobias
118
(let ((mumble (make-instance 'mumble)))
21:49:43 '
119
(5am:is (eql t
'
120
(#_connect "QObject"
'
121
mumble (qt:qsignal "say(int)")
'
122
mumble (qt:qslot "listen(int)"))))
'
123
(5am:is (eql t
'
124
(#_connect "QObject"
'
125
mumble (qt:qsignal "think(int)")
'
126
mumble (qt:qsignal "say(int)"))))
'
127
(5am:is (eql nil (mumble-called mumble)))
'
128
(emit-signal mumble "think(int)" 37)
'
129
(5am:is (eql t (mumble-called mumble)))))
'
130
2009-07-02 tobias
131
(5am:test make-qapplication
2009-07-24 tobias
132
"Test QApplication creation with QT:MAKE-QAPPLICATION."
2009-07-02 tobias
133
(let ((application (make-qapplication)))
17:34:07 '
134
(5am:is (eql (#_instance "QCoreApplication")
'
135
application))
'
136
(5am:is (eql t (typep application 'cl-smoke.qt:application)))
'
137
(smoke:delete-object application)))
2009-07-24 tobias
138
13:39:55 '
139
(5am:test noops
'
140
(qt:ensure-smoke)
'
141
(qt:enable-syntax))
'
142
'
143
(5am:test docu
2009-08-27 tobias
144
(with-output-to-string (*standard-output*)
11:17:58 '
145
(qapropos "QObject")
'
146
(qdescribe "QObject")))
2009-07-24 tobias
147
2010-01-10 tobias
148
(defun run ()
2009-07-02 tobias
149
(let ((results (5am:run :cl-smoke.commonqt-suite)))
17:34:07 '
150
(5am:explain! results)
'
151
(unless (5am:results-status results)
2010-01-10 tobias
152
(error "Testsuite failed."))))