darcs - commonqt

2 ;;;

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.

28 (in-package :cl-smoke.commonqt)

30 (5am:def-suite :cl-smoke.commonqt-suite)

31 (5am:in-suite :cl-smoke.commonqt-suite)

32 (declaim (optimize (debug 3)))

34 (5am:test static-call

35 "Test static method call."

36 (5am:is (string= (cl-smoke.qt:q-version)

37 (#_qVersion "GlobalSpace"))))

39 (5am:test enum

40 "Test enum access."

41 (5am:is (enum= cl-smoke.qt:+blue+

42 (#_blue "Qt")))

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"))))

48 (5am:test new

49 "Test allocating with #_new."

50 (5am:is (cxx:= (make-instance 'cl-smoke.qt:byte-array :args '("foobar"))

51 (#_new QByteArray "foobar"))))

53 (5am:test call

54 "Test #_ method calling."

55 (let ((byte-array (make-instance 'cl-smoke.qt:byte-array :args '("foobar"))))

56 (5am:is (string= (cxx:data byte-array)

57 (#_data byte-array)))))

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)))

65 (defmethod initialize-instance :after ((instance button) &rest initargs)

66 (declare (ignore initargs))

67 (new instance "foobar"))

69 (defmethod meta-object ((this button))

70 (setf (button-meta-object-called this) t)

71 (call-next-qmethod))

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))))))

81 (5am:test overriding

82 "Test overriding a virtual method."

83 (cl-smoke.qt:with-app ()

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))))))

89 (defclass mumble ()

90 ((called :accessor mumble-called :initform nil))

91 (:metaclass qt-class)

92 (:qt-superclass "QObject")

93 (:slots ("listen(int)" (lambda (this value)

94 (5am:is (= 37 value))

95 (setf (mumble-called this) t))))

96 (:signals ("say(int)") ("think(int)")))

98 (defmethod initialize-instance :after ((instance mumble) &rest initargs)

99 (declare (ignore initargs))

100 (new instance))

101

102 (5am:test signal-slot

103 "Test signal to slot connection."

104 (let ((mumble (make-instance 'mumble)))

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

116 (5am:test (signal-signal :depends-on signal-slot)

117 "Test signal to signal connection."

118 (let ((mumble (make-instance 'mumble)))

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

131 (5am:test make-qapplication

132 "Test QApplication creation with QT:MAKE-QAPPLICATION."

133 (let ((application (make-qapplication)))

134 (5am:is (eql (#_instance "QCoreApplication")

135 application))

136 (5am:is (eql t (typep application 'cl-smoke.qt:application)))

137 (smoke:delete-object application)))

138

139 (5am:test noops

140 (qt:ensure-smoke)

141 (qt:enable-syntax))

142

143 (5am:test docu

144 (with-output-to-string (*standard-output*)

145 (qapropos "QObject")

146 (qdescribe "QObject")))

147

148 (defun run ()

149 (let ((results (5am:run :cl-smoke.commonqt-suite)))

150 (5am:explain! results)

151 (unless (5am:results-status results)

152 (error "Testsuite failed."))))