From: Marco Baringer Date: Thu, 29 Nov 2012 09:21:24 +0000 (+0100) Subject: Added ability to specify fixtures on the suite object itself (instead of having to... X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a7d389cd1eebbc3cbfae58a8885d07680eb7ae8f;p=fiveam.git Added ability to specify fixtures on the suite object itself (instead of having to specify it on every test) --- diff --git a/src/classes.lisp b/src/classes.lisp index fc4dc78..fa099ce 100644 --- a/src/classes.lisp +++ b/src/classes.lisp @@ -36,7 +36,10 @@ ((tests :accessor tests :initform (make-hash-table :test 'eql) :documentation "The hash table mapping names to test objects in this suite. The values in this hash table - can be either test-cases or other test-suites.")) + can be either test-cases or other test-suites.") + (fixture :accessor fixture :initform nil :initarg :fixture + :documentation "FIXTURE to use, by default, for tests in + this suite.")) (:documentation "A test suite is a collection of tests or test suites. Test suites serve to organize tests into groups so that the diff --git a/src/suite.lisp b/src/suite.lisp index 43e5f70..1942cc1 100644 --- a/src/suite.lisp +++ b/src/suite.lisp @@ -16,17 +16,23 @@ ;;;; ** Creating Suits -(defmacro def-suite (name &key description in) +(defmacro def-suite (name &key description (in nil in-p) (fixture nil fixture-p)) "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." +named NAME. + +DESCRIPTION is just a string. + +FIXTURE is the fixture argument (exactly like the :fixture argument to +def-test) to pass to tests in this suite." `(eval-when (:compile-toplevel :load-toplevel :execute) (make-suite ',name ,@(when description `(:description ,description)) - ,@(when in `(:in ',in))) + ,@(when in-p `(:in ',in)) + ,@(when fixture-p `(:fixture ',fixture))) ',name)) (defmacro def-suite* (name &rest def-suite-args) @@ -34,11 +40,11 @@ named NAME." (def-suite ,name ,@def-suite-args) (in-suite ,name))) -(defun make-suite (name &key description ((:in parent-suite))) +(defun make-suite (name &key description ((:in parent-suite)) fixture) "Create a new test suite object. Overrides any existing suite named NAME." - (let ((suite (make-instance 'test-suite :name name))) + (let ((suite (make-instance 'test-suite :name name :fixture fixture))) (when description (setf (description suite) description)) (loop for i in (ensure-list parent-suite) diff --git a/src/test.lisp b/src/test.lisp index e4ca2d8..defb357 100644 --- a/src/test.lisp +++ b/src/test.lisp @@ -79,11 +79,16 @@ is compiled." (suite-form (if suite-p `(get-test ',suite) '*suite*)) - (effective-body (if fixture - (destructuring-bind (name &rest args) - (ensure-list fixture) - `((with-fixture ,name ,args ,@body-forms))) - body-forms))) + (effective-body (let* ((test-fixture fixture) + (suite-fixture (if suite-p + (fixture (get-test suite)) + (fixture *suite*))) + (effective-fixture (or test-fixture suite-fixture))) + (if effective-fixture + (destructuring-bind (name &rest args) + (ensure-list effective-fixture) + `((with-fixture ,name ,args ,@body-forms))) + body-forms)))) `(progn (register-test ',name ,description ',effective-body ,suite-form ',depends-on ,compile-at ,profile) (when *run-test-when-defined* diff --git a/t/tests.lisp b/t/tests.lisp index 741a8d6..3592ee5 100644 --- a/t/tests.lisp +++ b/t/tests.lisp @@ -258,3 +258,15 @@ (for-all (((a b) (dummy-mv-generator))) (is (= 1 a)) (is (= 1 b)))) + +(defvar *special-variable* nil) + +(def-fixture fixture-for-suite (value) + (progn + (setf *special-variable* value) + (&body))) + +(def-suite suite-with-fixture :fixture (fixture-for-suite 42) :in :it.bese.fiveam) + +(def-test test-with-suite-fixture (:suite suite-with-fixture) + (is (= 42 *special-variable*)))