From a7d389cd1eebbc3cbfae58a8885d07680eb7ae8f Mon Sep 17 00:00:00 2001
From: Marco Baringer <mb@bese.it>
Date: Thu, 29 Nov 2012 10:21:24 +0100
Subject: [PATCH] Added ability to specify fixtures on the suite object itself
 (instead of having to specify it on every test)

---
 src/classes.lisp |    5 ++++-
 src/suite.lisp   |   16 +++++++++++-----
 src/test.lisp    |   15 ++++++++++-----
 t/tests.lisp     |   12 ++++++++++++
 4 files changed, 37 insertions(+), 11 deletions(-)

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*)))
-- 
1.7.10.4