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