Sat Apr 3 21:13:24 CEST 2010 Tobias Rautenkranz * Test static member variable access using slot-value with a class object. Sat Apr 3 14:52:50 CEST 2010 Tobias Rautenkranz * Test slot-value for C++ attributes. Sat Apr 3 14:50:36 CEST 2010 Tobias Rautenkranz * Test qt.opengl conversions. Sat Feb 20 22:06:45 CET 2010 Tobias Rautenkranz * Test (qt:value (qt:make-variant qt:+green+)) Sat Feb 20 19:06:27 CET 2010 Tobias Rautenkranz * Test overload resolution exact match for long and ulong. Mon Jan 25 22:13:40 CET 2010 Tobias Rautenkranz * Test QGraphicsScene::setItem Mon Jan 25 19:51:13 CET 2010 Tobias Rautenkranz * Test QList translation Sat Jan 23 23:18:13 CET 2010 Tobias Rautenkranz * Test to QVector translation. Sun Jan 10 09:57:03 CET 2010 Tobias Rautenkranz * ASDF & modular smoke. diff -rN -u old-qt.tests/cl-smoke.qt.tests.asd new-qt.tests/cl-smoke.qt.tests.asd --- old-qt.tests/cl-smoke.qt.tests.asd 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.tests/cl-smoke.qt.tests.asd 2014-11-19 23:10:44.000000000 +0100 @@ -0,0 +1,35 @@ +(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 :cl-smoke.qt.opengl + :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 "qvector" :depends-on ("tests")) + (:file "qlist" :depends-on ("tests")) + (:file "graphics-item" :depends-on ("tests")) + (:file "overload" :depends-on ("tests")) + (:file "opengl" :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)))) diff -rN -u old-qt.tests/qt.tests.mbd new-qt.tests/qt.tests.mbd --- old-qt.tests/qt.tests.mbd 2014-11-19 23:10:44.000000000 +0100 +++ new-qt.tests/qt.tests.mbd 1970-01-01 01:00:00.000000000 +0100 @@ -1,30 +0,0 @@ -;;;; -*- 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")))))) diff -rN -u old-qt.tests/src/application.lisp new-qt.tests/src/application.lisp --- old-qt.tests/src/application.lisp 2014-11-19 23:10:44.000000000 +0100 +++ new-qt.tests/src/application.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -11,11 +11,13 @@ (if core-p (qt:with-core-app () (5am:is (eql t (qt:app-p))) - (5am:is (typep (qt:app) (find-class 'qt:core-application))) + (5am:is (string= "QCoreApplication" + (cxx:class-name (cxx:meta-object (qt:app))))) (setf (cxx:object-name (qt:app)) "core-app")) ;; test for memfault (qt:with-app () (5am:is (eql t (qt:app-p))) - (5am:is (typep (qt:app) (find-class 'qt:application))) + (5am:is (string= "QApplication" + (cxx:class-name (cxx:meta-object (qt:app))))) (setf (cxx:object-name (qt:app)) "app"))) (unless nested (5am:is (eql nil (qt:app-p))))))) diff -rN -u old-qt.tests/src/graphics-item.lisp new-qt.tests/src/graphics-item.lisp --- old-qt.tests/src/graphics-item.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.tests/src/graphics-item.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -0,0 +1,18 @@ +(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)))) diff -rN -u old-qt.tests/src/opengl.lisp new-qt.tests/src/opengl.lisp --- old-qt.tests/src/opengl.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.tests/src/opengl.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -0,0 +1,24 @@ +(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)))) diff -rN -u old-qt.tests/src/package.lisp new-qt.tests/src/package.lisp --- old-qt.tests/src/package.lisp 2014-11-19 23:10:44.000000000 +0100 +++ new-qt.tests/src/package.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -1,3 +1,3 @@ (defpackage :qt.tests - (:use :cl :trivial-garbage :bordeaux-threads) + (:use :cl :trivial-garbage :bordeaux-threads :cxx-support) (:export :run)) diff -rN -u old-qt.tests/src/properties.lisp new-qt.tests/src/properties.lisp --- old-qt.tests/src/properties.lisp 2014-11-19 23:10:44.000000000 +0100 +++ new-qt.tests/src/properties.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -35,3 +35,24 @@ (5am:for-all ((integer (5am:gen-integer))) (setf (qt:property o 'foo-bar) integer) (5am:is (= integer (qt:property o 'foo-bar)))))) + +(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 (slot-boundp (find-class 'qt:object) :static-meta-object)) + (5am:is (string= "QObject" + (cxx:class-name + (slot-value o :static-meta-object)))) + (5am:is (string= "QObject" + (cxx:class-name + (slot-value (find-class 'qt:object) + :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))))) diff -rN -u old-qt.tests/src/qbytearray.lisp new-qt.tests/src/qbytearray.lisp --- old-qt.tests/src/qbytearray.lisp 2014-11-19 23:10:44.000000000 +0100 +++ new-qt.tests/src/qbytearray.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -8,6 +8,11 @@ (5am:test bytearray "Test string <-> QByteArray." + (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? (5am:for-all ((string (5am:gen-string))) (5am:is (string= string (cxx:data (make-instance 'qt:byte-array diff -rN -u old-qt.tests/src/qlist.lisp new-qt.tests/src/qlist.lisp --- old-qt.tests/src/qlist.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.tests/src/qlist.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -0,0 +1,11 @@ +(in-package :qt.tests) + +(5am:in-suite :qt.suite) + +(5am:test variant-list + "QList" + (let ((variants (vector (qt:make-variant "foo")))) + (5am:is (every #'cxx:= + variants + (cxx:to-list (qt:make-variant variants)))))) + diff -rN -u old-qt.tests/src/qvector.lisp new-qt.tests/src/qvector.lisp --- old-qt.tests/src/qvector.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-qt.tests/src/qvector.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -0,0 +1,41 @@ +(in-package :qt.tests) + +(5am:in-suite :qt.suite) + +(5am:test qvector-qpoint + "Tests to QVector 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 + (tg:gc :full t)) + +(5am:test qvector-double + "Test QVector <-> 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 <-> 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))))) diff -rN -u old-qt.tests/src/signal-slot.lisp new-qt.tests/src/signal-slot.lisp --- old-qt.tests/src/signal-slot.lisp 2014-11-19 23:10:44.000000000 +0100 +++ new-qt.tests/src/signal-slot.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -15,7 +15,7 @@ (5am:test (emit-int-signal :depends-on with-app) "Emits a signal with a C++ integer argument to a C++ slot." - (qt:with-core-app () + (qt:with-app () (let ((my-signal (qt:make-signal)) (label (make-instance 'qt:label))) (qt:connect my-signal (qt:get-slot label "setNum(int)")) @@ -25,7 +25,7 @@ (5am:test (emit-float-signal :depends-on with-app) "Emits a signal with a C++ integer argument to a C++ slot." - (qt:with-core-app () + (qt:with-app () (let ((my-signal (qt:make-signal)) (label (make-instance 'qt:label))) (qt:connect my-signal (qt:get-slot label "setNum(double)")) diff -rN -u old-qt.tests/src/variant.lisp new-qt.tests/src/variant.lisp --- old-qt.tests/src/variant.lisp 2014-11-19 23:10:44.000000000 +0100 +++ new-qt.tests/src/variant.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -45,3 +45,17 @@ '(1 "asdf" #\a))))) (5am:is (string= "QVariantList" (cxx:type-name list))))) + +(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. + +(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))))))) diff -rN -u old-qt.tests/test.lisp new-qt.tests/test.lisp --- old-qt.tests/test.lisp 2014-11-19 23:10:44.000000000 +0100 +++ new-qt.tests/test.lisp 2014-11-19 23:10:44.000000000 +0100 @@ -3,7 +3,7 @@ # Used for testing on darcs record. |# -(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) (sb-ext:quit)