Mon Apr 6 13:43:59 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* make unit test work & test on darcs record
diff -rN -u old-qt.core/src/application.lisp new-qt.core/src/application.lisp
--- old-qt.core/src/application.lisp 2014-10-30 07:34:05.000000000 +0100
+++ new-qt.core/src/application.lisp 2014-10-30 07:34:05.000000000 +0100
@@ -63,15 +63,10 @@
(makunbound '*app*)))
(defmacro with-application ((ensure-app remove-app) &body body)
- (let ((cleanup-p (gensym "cleanup-p")))
- `(let ((,cleanup-p nil))
- (multiple-value-setq (*app* ,cleanup-p) ,ensure-app)
- (unwind-protect
- (progn
- ,@body)
- (when ,cleanup-p
- ,remove-app
- (makunbound '*app*))))))
+ `(progn (setf *app* ,ensure-app)
+ (unwind-protect
+ (progn
+ ,@body))))
(defmacro with-app (&body body)
"Ensures that a APPLICATION instance exists,
diff -rN -u old-qt.core/test.lisp new-qt.core/test.lisp
--- old-qt.core/test.lisp 2014-10-30 07:34:05.000000000 +0100
+++ new-qt.core/test.lisp 2014-10-30 07:34:05.000000000 +0100
@@ -1,21 +1,25 @@
-#!/usr/bin/sbcl --script
+#|
+exec -a "$0" sbcl --noinform --noprint --disable-debugger --load $0 --end-toplevel-options "$@"
+# do not use --script to allow loading mudballs with ${HOME}/.sbclrc
+# Used for testing on darcs record.
+|#
-(load "/home/tobias/software/mudballs/boot.lisp")
(in-package :sysdef-user)
-(defmacro with-extra-search-dir (path &body body)
- "Executes BODY with PATH as additional search directory for Mudball systems."
- `(let ((*custom-search-modules*
- (pushnew (wildcard-searcher
- (make-pathname :name :wild
- :type "mbd"
- :defaults ,path))
- *custom-search-modules*)))
- ,@body))
-
-(with-extra-search-dir *default-pathname-defaults*
- (mb:clean :qt)
- (mb:test :qt))
+(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)
+(mb:clean :qt)
+(mb:test :qt)
(sb-ext:quit)