X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fsuite.lisp;h=bf1cc100b6721fcee7541e4cb98a3913b11d6af1;hb=660083a151da6492d44a5e21113d2c6064ea7817;hp=bed1945b3293bedc788dc5f30c0611e3989fdd22;hpb=503a35c263e4799597e656da5ae088fc678ece48;p=fiveam.git diff --git a/src/suite.lisp b/src/suite.lisp index bed1945..bf1cc10 100644 --- a/src/suite.lisp +++ b/src/suite.lisp @@ -16,24 +16,33 @@ ;;;; ** Creating Suits -(defmacro def-suite (name &key description in) +(defmacro def-suite (name &key description in default-test-args) "Define a new test-suite named NAME. IN (a symbol), if provided, causes this suite te be nested in the suite named by IN. NB: This macro is built on top of make-suite, as such it, like make-suite, will overrwrite any existing suite -named NAME." - `(progn +named NAME. + +DEFAULT-TEST-ARGS, if provided, will ba passed to the TEST forms +defined in this suite." + `(eval-when (:compile-toplevel :load-toplevel :execute) (make-suite ',name - ,@(when description `(:description ,description)) - ,@(when in `(:in ',in))) + ,@(when description `(:description ,description)) + ,@(when in `(:in ',in)) + ,@(when default-test-args `(:default-test-args ,default-test-args))) ',name)) -(defun make-suite (name &key description in) +(defmacro def-suite* (name &rest def-suite-args) + `(progn + (def-suite ,name ,@def-suite-args) + (in-suite ,name))) + +(defun make-suite (name &key description in default-test-args) "Create a new test suite object. Overides any existing suite named NAME." - (let ((suite (make-instance 'test-suite :name name))) + (let ((suite (make-instance 'test-suite :name name :default-test-args default-test-args))) (when description (setf (description suite) description)) (loop for i in (ensure-list in) @@ -59,14 +68,23 @@ after the execution of this form are, unless specified otherwise, in the test-suite named SUITE-NAME. See also: DEF-SUITE *SUITE*" + `(eval-when (:compile-toplevel :load-toplevel :execute) + (%in-suite ,suite-name))) + +(defmacro in-suite* (suite-name &key in) + "Just like in-suite, but silently creates missing suites." + `(%in-suite ,suite-name :in ,in :fail-on-error nil)) + +(defmacro %in-suite (suite-name &key (fail-on-error t) in) (with-unique-names (suite) `(progn (if-bind ,suite (get-test ',suite-name) (setf *suite* ,suite) (progn - (cerror "Create a new suite named ~A." - "Unkown suite ~A." ',suite-name) - (setf (get-test ',suite-name) (make-suite ',suite-name) + (when ,fail-on-error + (cerror "Create a new suite named ~A." + "Unkown suite ~A." ',suite-name)) + (setf (get-test ',suite-name) (make-suite ',suite-name :in ',in) *suite* (get-test ',suite-name)))) ',suite-name)))