X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Ftest.lisp;h=af7225a0bca77c380834263c2a145e51383de8b1;hb=085b9010ceb3b650a11e6311cea38157fec2acb5;hp=82b0c6cb7d11fe3c6c36c84c89db92395a30efc2;hpb=1454981ac5f4f7ea8fe741a8125efbf0b09497ea;p=fiveam.git diff --git a/src/test.lisp b/src/test.lisp index 82b0c6c..af7225a 100644 --- a/src/test.lisp +++ b/src/test.lisp @@ -16,7 +16,7 @@ names to objects.") (defmacro test (name &body body) - "Create a suite named NAME. If NAME is a list it must be of the + "Create a test named NAME. If NAME is a list it must be of the form: (name &key depends-on suite) @@ -43,25 +43,30 @@ depending on another. SUITE defaults to the current value of *SUITE*." (destructuring-bind (name &key depends-on (suite nil suite-supplied-p)) (ensure-list name) - (let (lambda description) + (let (description) (setf description (if (stringp (car body)) (pop body) - "") - lambda body) + "")) `(progn - (setf (get-test ',name) - (make-instance 'test-case - :name ',name - :test-lambda (lambda () ,@lambda) - :description ,description - :depends-on ',depends-on)) + (setf (get-test ',name) (make-instance 'test-case + :name ',name + :test-lambda + (lambda () + (funcall (compile nil '(lambda () ,@body)))) + :description ,description + :depends-on ',depends-on)) ,(if suite-supplied-p `(setf (gethash ',name (tests (get-test ',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. ;;