Sun Jan 10 09:53:29 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* modular smoke & test system.
diff -rN -u old-commonqt/cl-smoke.commonqt-tests.asd new-commonqt/cl-smoke.commonqt-tests.asd
--- old-commonqt/cl-smoke.commonqt-tests.asd 1970-01-01 01:00:00.000000000 +0100
+++ new-commonqt/cl-smoke.commonqt-tests.asd 2014-10-30 06:54:28.000000000 +0100
@@ -0,0 +1,13 @@
+(defsystem :cl-smoke.commonqt-tests
+ :name :cl-smoke.commonqt-tests
+ :author "Tobias Rautenkranz"
+ :license "GPL with linking exception"
+ :depends-on (:cl-smoke.commonqt :FiveAM)
+
+ :components
+ ((:module "tests"
+ :components
+ ((:file "test")))))
+
+(defmethod perform ((o test-op) (c (eql (find-system :cl-smoke.commonqt-tests))))
+ (funcall (intern (string :run) (string :cl-smoke.commonqt))))
diff -rN -u old-commonqt/cl-smoke.commonqt.asd new-commonqt/cl-smoke.commonqt.asd
--- old-commonqt/cl-smoke.commonqt.asd 1970-01-01 01:00:00.000000000 +0100
+++ new-commonqt/cl-smoke.commonqt.asd 2014-10-30 06:54:28.000000000 +0100
@@ -0,0 +1,19 @@
+(defsystem :cl-smoke.commonqt
+ :name :cl-smoke.commonqt
+ :version (0 0 1)
+ :author "Tobias Rautenkranz"
+ :license "GPL with linking exception"
+ :description "cl-smoke CommonQt compability layer.
+Allows the usage of cl-smoke using the CommonQt API."
+ :depends-on (:cl-smoke.smoke :cl-smoke.qt.gui :cl-ppcre :cffi)
+
+ :components
+ ((:module "src"
+ :components
+ ((:file "package")
+ (:file "signal-slot" :depends-on ("commonqt"))
+ (:file "commonqt" :depends-on ("package"))))))
+
+(defmethod perform ((o test-op) (c (eql (find-system :cl-smoke.commonqt))))
+ (operate 'asdf:load-op :cl-smoke.commonqt-tests)
+ (operate 'asdf:test-op :cl-smoke.commonqt-tests))
diff -rN -u old-commonqt/commonqt.mbd new-commonqt/commonqt.mbd
--- old-commonqt/commonqt.mbd 2014-10-30 06:54:28.000000000 +0100
+++ new-commonqt/commonqt.mbd 1970-01-01 01:00:00.000000000 +0100
@@ -1,16 +0,0 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-(in-package :sysdef-user)
-
-(define-system :cl-smoke.commonqt ()
- (:version 0 0 1)
- (:documentation "cl-smoke CommonQt compability layer.
-Allows the usage of cl-smoke using the CommonQt API.")
- (:author "Tobias Rautenkranz")
- (:license "GPL with linking exception")
- (:needs :smoke :qt :cl-ppcre :cffi)
- (:components
- ("src" module
- (:components
- "package"
- ("signal-slot" (:needs "commonqt"))
- ("commonqt" (:needs "package"))))))
diff -rN -u old-commonqt/src/commonqt.lisp new-commonqt/src/commonqt.lisp
--- old-commonqt/src/commonqt.lisp 2014-10-30 06:54:28.000000000 +0100
+++ new-commonqt/src/commonqt.lisp 2014-10-30 06:54:28.000000000 +0100
@@ -1,4 +1,4 @@
-;;; Copyright (C) 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
+;;; Copyright (C) 2009, 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
@@ -27,6 +27,12 @@
(in-package :cl-smoke.commonqt)
+;; FIXME
+;; There is a GLOBAL-SPACE class per module, for now we just use the :qt.core one.
+;; But it should be selected in the method call. e.g.: (#_qVersion "GlobalSpace")
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import 'cl-smoke.qt.core::global-space :cl-smoke.qt))
+
;;; initialization
(defun ensure-smoke ())
(defun enable-syntax ())
@@ -84,7 +90,7 @@
(instance)
"The instance ~A is already constructed." instance)
(setf (slot-value instance 'smoke:pointer)
- (smoke::call-constructor instance arguments))
+ (smoke::call-constructor (class-of instance) arguments))
(smoke::set-binding instance)
(smoke::take-ownership instance)
(smoke::add-object instance)
@@ -216,10 +222,9 @@
this)
(apply (aref (method-functions (class-of this)) m-id)
this
- (cl-smoke.qt-impl::arguments-to-lisp
+ (cl-smoke.qt.core::arguments-to-lisp
arguments
- (cl-smoke.qt-impl::method-arguments-type
- (cxx:meta-object this) id)))))
+ (cl-smoke.qt.core::method-arguments-type this id)))))
(- m-id
(length (method-functions (class-of this)))))
m-id))))
@@ -242,8 +247,8 @@
(assert (>= id 0)
()
"No signal ~A of ~A." signal-name object)
- (cl-smoke.qt-impl::activate
- object id (cl-smoke.qt-impl::method-arguments-type meta-object id)
+ (cl-smoke.qt.core::activate
+ object id (cl-smoke.qt.core::method-arguments-type object id)
arguments)))
(defmacro call-next-qmethod ()
@@ -275,8 +280,10 @@
;;;
(defun qapropos (name)
- (smoke::fgrep-classes cl-smoke.qt-impl::*smoke-module* name)
- (smoke::fgrep-methods cl-smoke.qt-impl::*smoke-module* name))
+ (smoke::fgrep-classes cl-smoke.qt.core::*smoke-module* name)
+ (smoke::fgrep-classes cl-smoke.qt.gui::*smoke-module* name)
+ (smoke::fgrep-methods cl-smoke.qt.core::*smoke-module* name)
+ (smoke::fgrep-methods cl-smoke.qt.gui::*smoke-module* name))
;; FIXME: implement QDESCRIBE
(defun qdescribe (name)
diff -rN -u old-commonqt/test.lisp new-commonqt/test.lisp
--- old-commonqt/test.lisp 2014-10-30 06:54:28.000000000 +0100
+++ new-commonqt/test.lisp 2014-10-30 06:54:28.000000000 +0100
@@ -5,21 +5,7 @@
# Used for testing on darcs record.
|#
-
-(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 file-name)
- "Loads a mbd file in the current directory."
- (load-sysdef (make-pathname :defaults *default-pathname-defaults*
- :name file-name
- :type "mbd")
- system-name))
-
-(load-sysdef-file :cl-smoke.commonqt "commonqt")
-(mb:test :cl-smoke.commonqt)
+(asdf:oos 'asdf:load-op :cl-smoke.commonqt)
+(asdf:oos 'asdf:test-op :cl-smoke.commonqt)
(sb-ext:quit)
diff -rN -u old-commonqt/tests/test.lisp new-commonqt/tests/test.lisp
--- old-commonqt/tests/test.lisp 2014-10-30 06:54:28.000000000 +0100
+++ new-commonqt/tests/test.lisp 2014-10-30 06:54:28.000000000 +0100
@@ -1,4 +1,4 @@
-;;; Copyright (C) 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
+;;; Copyright (C) 2009, 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
@@ -25,13 +25,11 @@
;;; do so. If you do not wish to do so, delete this exception statement
;;; from your version.
-(eval-when (:compile-toplevel :load-toplevel)
- (mb:load :FiveAM))
-
(in-package :cl-smoke.commonqt)
(5am:def-suite :cl-smoke.commonqt-suite)
(5am:in-suite :cl-smoke.commonqt-suite)
+(declaim (optimize (debug 3)))
(5am:test static-call
"Test static method call."
@@ -92,7 +90,7 @@
((called :accessor mumble-called :initform nil))
(:metaclass qt-class)
(:qt-superclass "QObject")
- (:slots ("listen(int)" (lambda (this &optional value)
+ (:slots ("listen(int)" (lambda (this value)
(5am:is (= 37 value))
(setf (mumble-called this) t))))
(:signals ("say(int)") ("think(int)")))
@@ -147,8 +145,8 @@
(qapropos "QObject")
(qdescribe "QObject")))
-(eval-when (:load-toplevel)
+(defun run ()
(let ((results (5am:run :cl-smoke.commonqt-suite)))
(5am:explain! results)
(unless (5am:results-status results)
- (error "Testsuite :qt.suite failed."))))
+ (error "Testsuite failed."))))