X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Ftest.lisp;h=99bc8bbab54ff9c0568eb3cbdabbb224ba47a79c;hb=71b6fc1cd91159a5ff28432701dea1fe85831df1;hp=7d763d10fed8570fc2185ebd8aca39fc6b3976f7;hpb=ea24d851569099877c8aa18899c2744b5070d7e3;p=fiveam.git diff --git a/src/test.lisp b/src/test.lisp index 7d763d1..99bc8bb 100644 --- a/src/test.lisp +++ b/src/test.lisp @@ -12,9 +12,14 @@ ;;;; collection of tests and test suites. (deflookup-table test + :at-redefinition nil :documentation "Lookup table mapping test (and test suite) names to objects.") +(defun test-names () + (loop for test being the hash-keys of *test* + collect test)) + (defmacro test (name &body body) "Create a test named NAME. If NAME is a list it must be of the form: @@ -50,9 +55,11 @@ SUITE defaults to the current value of *SUITE*." `(progn (setf (get-test ',name) (make-instance 'test-case :name ',name + :runtime-package ,*package* :test-lambda (lambda () - (funcall (compile nil '(lambda () ,@body)))) + (funcall (let ((*package* ,*package*)) + (compile nil '(lambda () ,@body))))) :description ,description :depends-on ',depends-on)) ,(if suite-supplied-p @@ -60,8 +67,13 @@ SUITE defaults to the current value of *SUITE*." ',name) `(setf (gethash ',name (tests (or *suite* (get-test 'NIL)))) ',name)) + (when *run-test-when-defined* + (run! ',name)) ',name)))) +(defvar *run-test-when-defined* nil + "When non-NIL tests are run as soon as they are defined.") + ;; Copyright (c) 2002-2003, Edward Marco Baringer ;; All rights reserved. ;;