repos
/
commonqt
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
initial import
Annotate for file tests/test.lisp
2009-07-02 tobias
1
(eval-when (:compile-toplevel :load-toplevel)
17:34:07 '
2
(mb:load :FiveAM))
'
3
'
4
(in-package :cl-smoke.commonqt)
'
5
'
6
(5am:def-suite :cl-smoke.commonqt-suite)
'
7
(5am:in-suite :cl-smoke.commonqt-suite)
'
8
'
9
(5am:test static-call
'
10
(5am:is (string= (cl-smoke.qt:q-version)
'
11
(#_qVersion "GlobalSpace"))))
'
12
'
13
(5am:test enum
'
14
(5am:is (enum= cl-smoke.qt:+blue+
'
15
(#_blue "Qt"))))
'
16
'
17
(5am:test new
'
18
(5am:is (cxx:= (make-instance 'cl-smoke.qt:byte-array :args '("foobar"))
'
19
(#_new QByteArray "foobar"))))
'
20
'
21
(5am:test call
'
22
(let ((byte-array (make-instance 'cl-smoke.qt:byte-array :args '("foobar"))))
'
23
(5am:is (string= (cxx:data byte-array)
'
24
(#_data byte-array)))))
'
25
'
26
(defclass button ()
'
27
((called :accessor button-meta-object-called :initform nil))
'
28
(:metaclass qt-class)
'
29
(:qt-superclass "QPushButton")
'
30
(:override ("metaObject" meta-object)))
'
31
'
32
(defmethod initialize-instance :after ((instance button) &rest initargs)
'
33
(declare (ignore initargs))
'
34
(new instance "foobar"))
'
35
'
36
(defmethod meta-object ((this button))
'
37
(setf (button-meta-object-called this) t)
'
38
(call-next-qmethod))
'
39
'
40
(5am:test subclassing
'
41
(cl-smoke.qt:with-app ()
'
42
(let ((button (make-instance 'button)))
'
43
(5am:is (string= ""
'
44
(#_objectName button)))
'
45
(5am:is (string= "foobar"
'
46
(#_text button))))))
'
47
'
48
(5am:test overriding
'
49
(cl-smoke.qt:with-app ()
'
50
(let ((button (make-instance 'button)))
'
51
(5am:is (eql nil (button-meta-object-called button)))
'
52
(#_metaObject button)
'
53
(5am:is (eql t (button-meta-object-called button))))))
'
54
'
55
(defclass mumble ()
'
56
((called :accessor mumble-called :initform nil))
'
57
(:metaclass qt-class)
'
58
(:qt-superclass "QObject")
'
59
(:slots ("listen(int)" (lambda (this &optional value)
'
60
(5am:is (= 37 value))
'
61
(setf (mumble-called this) t))))
'
62
(:signals ("say(int)")))
'
63
'
64
(defmethod initialize-instance :after ((instance mumble) &rest initargs)
'
65
(declare (ignore initargs))
'
66
(new instance))
'
67
'
68
(5am:test signal-slot
'
69
(let ((mumble (make-instance 'mumble)))
'
70
(5am:is (eql t
'
71
(#_connect "QObject"
'
72
mumble (qt:qsignal "say(int)")
'
73
mumble (qt:qslot "listen(int)"))))
'
74
(5am:is (eql nil (mumble-called mumble)))
'
75
(emit-signal mumble "say(int)" 37)
'
76
(5am:is (eql t (mumble-called mumble)))
'
77
'
78
(5am:is (string= "QObject"
'
79
(#_className (#_superClass (#_metaObject mumble)))))))
'
80
'
81
(5am:test make-qapplication
'
82
(let ((application (make-qapplication)))
'
83
(5am:is (eql (#_instance "QCoreApplication")
'
84
application))
'
85
(5am:is (eql t (typep application 'cl-smoke.qt:application)))
'
86
(smoke:delete-object application)))
'
87
'
88
(eval-when (:load-toplevel)
'
89
(let ((results (5am:run :cl-smoke.commonqt-suite)))
'
90
(5am:explain! results)
'
91
(unless (5am:results-status results)
'
92
(error "Testsuite :qt.suite failed."))))