Sat Apr 3 21:13:24 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test static member variable access using slot-value with a class object.
hunk ./src/properties.lisp 43
+ (5am:is (slot-boundp (find-class 'qt:object) :static-meta-object))
hunk ./src/properties.lisp 47
+ (5am:is (string= "QObject"
+ (cxx:class-name
+ (slot-value (find-class 'qt:object)
+ :static-meta-object))))
Sat Apr 3 14:52:50 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test slot-value for C++ attributes.
hunk ./src/properties.lisp 39
+(5am:test attributes
+ "Test C++ attribute access with slot-* functions."
+ (let ((o (make-instance 'qt:object)))
+ (5am:is (slot-boundp o :static-meta-object))
+ (5am:is (string= "QObject"
+ (cxx:class-name
+ (slot-value o :static-meta-object))))
+ (5am:signals error
+ (setf (slot-value o :static-meta-object)
+ (cffi:null-pointer))))
+ (let ((data (make-instance 'qt:shared-data)))
+ (5am:is (slot-boundp data :ref))
+ (5am:for-all ((value (5am:gen-integer :min -255 :max 255)))
+ (setf (slot-value data :ref) value)
+ (5am:is (cxx:= (slot-value data :ref) value)))))
+
Sat Apr 3 14:50:36 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test qt.opengl conversions.
hunk ./cl-smoke.qt.tests.asd 7
- :depends-on (:cl-smoke.qt.test :cl-smoke.qt.gui :FiveAM :trivial-garbage :cl-smoke.smoke)
+ :depends-on (:cl-smoke.qt.test :cl-smoke.qt.gui :cl-smoke.qt.opengl
+ :FiveAM :trivial-garbage :cl-smoke.smoke)
hunk ./cl-smoke.qt.tests.asd 21
+ (:file "opengl" :depends-on ("tests"))
addfile ./src/opengl.lisp
hunk ./src/opengl.lisp 1
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(5am:test gluint
+ "GLuint conversion"
+ (qt:with-app ()
+ (let* ((texture (make-instance 'qt:pixmap))
+ (gl-widget (make-instance 'qt:glwidget))
+ (id (cxx:bind-texture gl-widget texture)))
+ (5am:is (typep id '(integer 0)))
+ (cxx:delete-texture gl-widget id))))
+ [_$_]
+
+(5am:test glint
+ "Test GLint and GLenum conversion."
+ (qt:with-app ()
+ (let* ((texture (make-instance 'qt:pixmap))
+ (target 3553) ;(cffi:foreign-enum-value '%gl:enum :texture-2d))
+ (format 6409) ;(cffi:foreign-enum-value '%gl:enum :rgba))
+ (gl-widget (make-instance 'qt:glwidget))
+ (id (cxx:bind-texture gl-widget texture target format)))
+ (5am:is (typep id '(integer 0)))
+ (cxx:delete-texture gl-widget id))))
Sat Feb 20 22:06:45 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test (qt:value (qt:make-variant qt:+green+))
hunk ./src/variant.lisp 57
+(5am:test variant-color
+ "Test QColor variant."
+ (let ((color (make-instance 'qt:color :arg0 qt:+green+)))
+ (5am:is (string= (cxx:name color)
+ (cxx:name (qt:value (qt:make-variant color)))))))
+
Sat Feb 20 19:06:27 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test overload resolution exact match for long and ulong.
hunk ./src/package.lisp 2
- (:use :cl :trivial-garbage :bordeaux-threads)
+ (:use :cl :trivial-garbage :bordeaux-threads :cxx-support)
hunk ./src/variant.lisp 49
+(5am:test exact-int-type-match
+ "Test overload resolution exact match long vs. int."
+ (5am:is (enum= qt:variant.+uint+
+ (cxx:type (qt:make-variant 1))))
+ (5am:is (enum= qt:variant.+int+
+ (cxx:type (qt:make-variant -1)))))
+ ;; on 32 bit sizeof(long) == sizeof(int) thus not test for that.
+
Mon Jan 25 22:13:40 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test QGraphicsScene::setItem
hunk ./cl-smoke.qt.tests.asd 18
+ (:file "graphics-item" :depends-on ("tests"))
addfile ./src/graphics-item.lisp
hunk ./src/graphics-item.lisp 1
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(5am:test set-graphics-item
+ "Ownership transfer for QGraphicsScene::setItem."
+ (qt:with-app ()
+ (let ((scene (make-instance 'qt:graphics-scene)))
+ (let ((item (make-instance 'qt:graphics-item)))
+ (cxx:set-tool-tip item "Foo")
+ (cxx:add-item scene item))
+ (tg:gc :full t)
+ (tg:gc :full t)
+ (5am:is (= 1 (length (cxx:items scene))))
+ (5am:is (string= "Foo"
+ (cxx:tool-tip (elt (cxx:items scene) 0))))
+ ;; FIXME delete QGraphicsScene before the QApplication is deleted
+ (smoke::delete-object scene))))
Mon Jan 25 19:51:13 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test QList translation
hunk ./cl-smoke.qt.tests.asd 17
+ (:file "qlist" :depends-on ("tests"))
addfile ./src/qlist.lisp
hunk ./src/qlist.lisp 1
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(5am:test variant-list
+ "QList<Variant>"
+ (let ((variants (vector (qt:make-variant "foo"))))
+ (5am:is (every #'cxx:=
+ variants
+ (cxx:to-list (qt:make-variant variants))))))
+ [_$_]
Sat Jan 23 23:18:13 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test to QVector<QPoint> translation.
hunk ./cl-smoke.qt.tests.asd 16
+ (:file "qvector" :depends-on ("tests"))
addfile ./src/qvector.lisp
hunk ./src/qvector.lisp 1
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(5am:test qvector-qpoint
+ "Tests to QVector<QPoint> translation."
+ (let* ((points
+ (map 'vector #'(lambda (coords)
+ (make-instance 'qt:point :arg0 (first coords)
+ :arg1 (rest coords)))
+ '((9 . 8) (7 . 6) (5 . 4))))
+ (polygon (make-instance 'qt:polygon :arg0 points)))
+ (dotimes (i (length points))
+ (5am:is (= (cxx:x (aref points i))
+ (cxx:x (cxx:point polygon i))))
+ (5am:is (= (cxx:y (aref points i))
+ (cxx:y (cxx:point polygon i))))))
+ ;; Free the allocated QVector<QPoint>
+ (tg:gc :full t))
hunk ./src/qvector.lisp 21
+(5am:test qvector-double
+ "Test QVector<double> <-> Lisp translation."
+ (5am:for-all ((pattern (5am:gen-one-element #()
+ #(1d0 2d0)
+ #(3.1415926d0 -10d0 1d10 0d0))))
+ (let ((pen (make-instance 'qt:pen))) ;; set-dash-pattern only works once!?
+ (cxx:set-dash-pattern pen pattern)
+ (5am:is (equalp pattern (cxx:dash-pattern pen))))))
+
+(5am:test qvector-uint
+ "Test QVector<unsigned int> <-> Lisp translation."
+ (let ((image (make-instance 'qt:image
+ :args (list 10 10 qt:image.+format-indexed8+)))
+ (colors (map 'vector
+ #'qt:q-rgb
+ '(1 2 44 55 255)
+ '(4 6 23 43 12)
+ '(5 0 23 12 123))))
+ (5am:is (equalp #() (cxx:color-table image)))
+ (cxx:set-color-table image colors)
+ (5am:is (equalp colors (cxx:color-table image)))))
+
Sun Jan 10 09:57:03 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* ASDF & modular smoke.
addfile ./cl-smoke.qt.tests.asd
hunk ./cl-smoke.qt.tests.asd 1
+(defsystem :cl-smoke.qt.tests
+ :name :cl-smoke.qt.tests
+ :version (0 0 1)
+ :author "Tobias Rautenkranz"
+ :license "GPL with linking exception"
+ :description "Qt unit tests."
+ :depends-on (:cl-smoke.qt.test :cl-smoke.qt.gui :FiveAM :trivial-garbage :cl-smoke.smoke)
+
+ :components
+ ((:module "src"
+ :components
+ ((:file "package")
+ (:file "tests" :depends-on ("package"))
+ (:file "qbytearray" :depends-on ("tests"))
+ (:file "qstring" :depends-on ("tests"))
+ (:file "overload" :depends-on ("tests"))
+ (:file "gc" :depends-on ("tests" "object"))
+ (:file "variant" :depends-on ("tests"))
+ (:file "application" :depends-on ("tests"))
+ (:file "signal-slot" :depends-on ("tests"))
+ (:file "operators" :depends-on ("tests"))
+ (:file "undo" :depends-on ("tests"))
+ (:file "abort" :depends-on ("tests"))
+ (:file "object" :depends-on ("tests"))
+ (:file "thread" :depends-on ("tests"))
+ (:file "properties" :depends-on ("tests"))
+ (:file "click" :depends-on ("tests"))))))
+
+(defmethod perform ((operation test-op) (c (eql (find-system :cl-smoke.qt.tests))))
+ (funcall (intern (string :run) (string :qt.tests))))
hunk ./qt.tests.mbd 1
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-
-(in-package :sysdef-user)
-
-(define-system :qt.tests ()
- (:version 0 0 1)
- (:documentation "Qt unit tests.")
- (:author "Tobias Rautenkranz")
- (:license "GPL with linking exception")
- (:needs :qt :qt.test :FiveAM :trivial-garbage)
- (:uses-macros-from :smoke)
- (:components [_$_]
- ("src" module
- (:components
- "package"
- ("tests" (:needs "package"))
- ("qbytearray" (:needs "tests"))
- ("qstring" (:needs "tests"))
- ("overload" (:needs "tests"))
- ("gc" (:needs "tests" "object"))
- ("variant" (:needs "tests"))
- ("application" (:needs "tests"))
- ("signal-slot" (:needs "tests"))
- ("operators" (:needs "tests"))
- ("undo" (:needs "tests"))
- ("abort" (:needs "tests"))
- ("object" (:needs "tests"))
- ("thread" (:needs "tests"))
- ("properties" (:needs "tests"))
- ("click" (:needs "tests"))))))
rmfile ./qt.tests.mbd
hunk ./src/application.lisp 14
- (5am:is (typep (qt:app) (find-class 'qt:core-application)))
+ (5am:is (string= "QCoreApplication"
+ (cxx:class-name (cxx:meta-object (qt:app)))))
hunk ./src/application.lisp 19
- (5am:is (typep (qt:app) (find-class 'qt:application)))
+ (5am:is (string= "QApplication"
+ (cxx:class-name (cxx:meta-object (qt:app)))))
hunk ./src/qbytearray.lisp 11
+ (5am:for-all ((string (5am:gen-one-element "" "Foo" "bar" "öäü" "1234")))
+ (5am:is (string= string
+ (cxx:data (make-instance 'qt:byte-array
+ :arg0 string)))))
+ #-openmcl ;; FIXME utf-8 problems with Clozure cl?
hunk ./src/signal-slot.lisp 18
- (qt:with-core-app ()
+ (qt:with-app ()
hunk ./src/signal-slot.lisp 28
- (qt:with-core-app ()
+ (qt:with-app ()
hunk ./test.lisp 6
-(adsf:operate 'asdf:load-op :qt.tests)
-(adsf:operate 'asdf:test-op :qt.tests)
+(asdf:operate 'asdf:load-op :cl-smoke.qt.tests)
+(asdf:operate 'asdf:test-op :cl-smoke.qt.tests)
changepref test
sh test.lisp
Sun Dec 13 13:45:36 CET 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Support ASDF instead of Mudballs.
hunk ./tests/test.lisp 1
-(in-package :qt.tests)
-
-(run)
rmfile ./tests/test.lisp
rmdir ./tests
hunk ./src/abort.lisp 84
+
+(5am:test msg-handler
+ "Test catching Q_ASSERTS."
+ (5am:signals error
+ (qt:qt-assert ":qt.tests msg-handler test assert"
+ "abort.lisp"
+ -1)))
+
hunk ./src/gc.lisp 13
- (dotimes (x 10)
+ (dotimes (x 30)
hunk ./src/qbytearray.lisp 14
- :args (list string)))))))
+ :arg0 string))))))
hunk ./src/qbytearray.lisp 18
- (let ((const-array (qt:operator+ (make-instance 'qt:byte-array)
- (make-instance 'qt:byte-array))))
- (5am:is (typep (cxx:operator[] (make-instance 'qt:byte-array) 0)
+ ;; Const operator[] returns a char, but the non const version a QByteRef.
+ ;; Using this to test constnes overload resolution.
+ (let ((const-array (qt:operator+ (make-instance 'qt:byte-array :arg0 "a")
+ (make-instance 'qt:byte-array :arg0 "b"))))
+ (5am:is (typep (cxx:operator[] (make-instance 'qt:byte-array :arg0 "a") 0)
hunk ./src/qbytearray.lisp 24
- (5am:is (eql #\Null (cxx:operator[] const-array 0)))))
+ (5am:is (eql #\a (cxx:operator[] const-array 0)))))
hunk ./test.lisp 3
-# do not use --script to allow loading mudballs with ${HOME}/.sbclrc
hunk ./test.lisp 6
-
-(in-package :sysdef-user)
-
-(defun load-sysdef (pathname system)
- (load pathname)
- (setf (mb.sysdef::pathname-of (find-system system)) pathname))
-
-(defun load-sysdef-file (system-name)
- "Loads a mbd file in the current directory."
- (load-sysdef (make-pathname :defaults *default-pathname-defaults*
- :name (string-downcase system-name)
- :type "mbd")
- system-name))
-
-(load-sysdef-file :qt.tests)
-(mb:clean :qt.tests)
-(mb:test :qt.tests)
+(adsf:operate 'asdf:load-op :qt.tests)
+(adsf:operate 'asdf:test-op :qt.tests)
changepref test
sh ./test.lisp
Wed Sep 2 14:02:23 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test Lisp to QList<QVariant> and test user conversion sequence for return values.
hunk ./src/overload.lisp 29
- (qt:make-variant (cxx:row index))
+ (cxx:row index) ;; cl-smoke converts to the required qt:variant
hunk ./src/variant.lisp 43
+(5am:test variant-list
+ (let ((list (qt:make-variant (map 'vector #'qt:make-variant
+ '(1 "asdf" #\a)))))
+ (5am:is (string= "QVariantList"
+ (cxx:type-name list)))))
+
Sun Aug 30 16:18:04 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test multiple C++ superclasses.
hunk ./qt.tests.mbd 20
- ("gc" (:needs "tests"))
+ ("gc" (:needs "tests" "object"))
hunk ./src/gc.lisp 19
- (5am:is (eql t
- (some #'(lambda (o) (null (weak-pointer-value o)))
- objects)))))
+ (5am:is (eq t (some #'(lambda (o) (null (weak-pointer-value o)))
+ objects)))))
hunk ./src/gc.lisp 40
+(5am:test gc-multi-object
+ "Test garbage collection of a custom object that has two C++ superclasses."
+ (test-gc 'my-multi-object))
+
hunk ./src/object.lisp 17
+(defclass my-multi-object (qt:object qt:graphics-item)
+ ()
+ (:metaclass cxx:class))
+
+(5am:test multi-object
+ "Tests a custom object that has two C++ superclasses."
+ (let ((object (make-instance 'my-multi-object)))
+ (5am:is (string= "" (cxx:object-name object)))
+ (5am:is (= qt:graphics-item.+user-type+
+ (cxx:type object)))))
+
Thu Aug 27 10:41:11 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Updates for the new smokegenerator.
* workaround missing default arguments for QTest::mouseClick
* test const correctness.
hunk ./src/click.lisp 23
- (qt:test.mouse-click widget qt:+left-button+)
+ (qt:test.mouse-click widget qt:+left-button+
+ 0 (make-instance 'qt:point) -1)
hunk ./src/click.lisp 26
- (qt:test.mouse-click widget qt:+right-button+)
+ (qt:test.mouse-click widget qt:+right-button+
+ 0 (make-instance 'qt:point) -1)
hunk ./src/click.lisp 40
- (qt:test.mouse-click widget qt:+left-button+)
+ (qt:test.mouse-click widget qt:+left-button+
+ 0 (make-instance 'qt:point) -1)
hunk ./src/click.lisp 43
- (qt:test.mouse-click widget qt:+left-button+)
+ (qt:test.mouse-click widget qt:+left-button+
+ 0 (make-instance 'qt:point) -1)
hunk ./src/click.lisp 59
- (qt:test.mouse-click widget qt:+left-button+)
+ (qt:test.mouse-click widget qt:+left-button+
+ 0 (make-instance 'qt:point) -1)
hunk ./src/click.lisp 62
- (qt:test.mouse-click widget qt:+left-button+)
+ (qt:test.mouse-click widget qt:+left-button+
+ 0 (make-instance 'qt:point) -1)
hunk ./src/gc.lisp 4
-
hunk ./src/gc.lisp 127
+ (setf (cxx:object-name grand-parent) "grand parent")
hunk ./src/gc.lisp 130
- (declare (ignore object)))
+ (setf (cxx:object-name parent) "parent"
+ (cxx:object-name object) "child"))
hunk ./src/gc.lisp 139
- (cxx:children c)))))))
+ (cxx:children c)))))))
hunk ./src/gc.lisp 141
-
hunk ./src/gc.lisp 144
- (let ((model (make-instance 'qt:string-list-model
- :args (list #("a" "b" "c"))))
+ (let ((model (make-instance 'qt:string-list-model :arg0 #("a" "b" "c")))
hunk ./src/gc.lisp 153
+ (cxx:destroyed (cxx:selection-model view)
+ (cxx:selection-model view))
hunk ./src/qbytearray.lisp 16
+(5am:test const-bytearray
+ "Test const QByteArray."
+ (let ((const-array (qt:operator+ (make-instance 'qt:byte-array)
+ (make-instance 'qt:byte-array))))
+ (5am:is (typep (cxx:operator[] (make-instance 'qt:byte-array) 0)
+ 'qt:byte-ref))
+ (5am:is (eql #\Null (cxx:operator[] const-array 0)))))
+
hunk ./src/signal-slot.lisp 155
- [_$_]
- (qt:connect (qt:get-signal signal-mapper "mapped(QObject*)")
+ ;; button is a QWidget thus it's mapped(QWidget*) and not
+ ;; mapped(QObject*)
+ (qt:connect (qt:get-signal signal-mapper "mapped(QWidget*)")
hunk ./src/signal-slot.lisp 162
- (qt:test.mouse-click button qt:+left-button+)
+ (qt:test.mouse-click button qt:+left-button+
+ 0 (make-instance 'qt:point) -1)