Ignoring non-repository paths: /test.lisp

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.

Sat Apr 3 14:52:50 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Test slot-value for C++ attributes.

Sat Apr 3 14:50:36 CEST 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Test qt.opengl conversions.

Sat Feb 20 22:06:45 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Test (qt:value (qt:make-variant qt:+green+))

Sat Feb 20 19:06:27 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Test overload resolution exact match for long and ulong.

Mon Jan 25 22:13:40 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Test QGraphicsScene::setItem

Mon Jan 25 19:51:13 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Test QList translation

Sat Jan 23 23:18:13 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Test to QVector<QPoint> translation.

Sun Jan 10 09:57:03 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* ASDF & modular smoke.

--- 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-10-30 08:00:54.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))))

--- old-qt.tests/qt.tests.mbd 2014-10-30 08:00:54.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"))))))

--- old-qt.tests/src/application.lisp 2014-10-30 08:00:54.000000000 +0100

+++ new-qt.tests/src/application.lisp 2014-10-30 08:00:54.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)))))))

--- old-qt.tests/src/graphics-item.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.tests/src/graphics-item.lisp 2014-10-30 08:00:54.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))))

--- old-qt.tests/src/opengl.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.tests/src/opengl.lisp 2014-10-30 08:00:54.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))))

--- old-qt.tests/src/package.lisp 2014-10-30 08:00:54.000000000 +0100

+++ new-qt.tests/src/package.lisp 2014-10-30 08:00:54.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))

--- old-qt.tests/src/properties.lisp 2014-10-30 08:00:54.000000000 +0100

+++ new-qt.tests/src/properties.lisp 2014-10-30 08:00:54.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)))))

--- old-qt.tests/src/qbytearray.lisp 2014-10-30 08:00:54.000000000 +0100

+++ new-qt.tests/src/qbytearray.lisp 2014-10-30 08:00:54.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

--- old-qt.tests/src/qlist.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.tests/src/qlist.lisp 2014-10-30 08:00:54.000000000 +0100

@@ -0,0 +1,11 @@

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

+

--- old-qt.tests/src/qvector.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-qt.tests/src/qvector.lisp 2014-10-30 08:00:54.000000000 +0100

@@ -0,0 +1,41 @@

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

+

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

--- old-qt.tests/src/signal-slot.lisp 2014-10-30 08:00:54.000000000 +0100

+++ new-qt.tests/src/signal-slot.lisp 2014-10-30 08:00:54.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)"))

--- old-qt.tests/src/variant.lisp 2014-10-30 08:00:54.000000000 +0100

+++ new-qt.tests/src/variant.lisp 2014-10-30 08:00:54.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)))))))

--- old-qt.tests/test.lisp 2014-10-30 08:00:54.000000000 +0100

+++ new-qt.tests/test.lisp 2014-10-30 08:00:54.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)