Simpler TEST-NAMES.

[fiveam.git] / src / suite.lisp

diff --git a/src/suite.lisp b/src/suite.lisp
index 1fbd70a..88bb34b 100644 (file)
--- a/src/suite.lisp
+++ b/src/suite.lisp
@@ -53,7 +53,7 @@ def-test) to pass to tests in this suite."
 
 (defun remove-from-suites (test-name)
   (when (get-test test-name)
-    ;; if this suite alruady exists, and its :IN some other suite, remove it.
+    ;; if this suite already exists, and its :IN some other suite, remove it.
     (dolist (s (list-all-suites))
       (when (gethash test-name (tests s))
         (remhash test-name (tests s))))))
@@ -81,8 +81,8 @@ Overrides any existing suite named NAME."
     suite))
 
 (defun list-all-suites ()
-  (loop for suite being the hash-value in *suites*
-       collect suite))
+  "Returns an unordered LIST of all suites."
+  (hash-table-values *suites*))
 
 ;;;; ** Managing the Current Suite
 
@@ -105,18 +105,21 @@ will be created (as per DEF-SUITE)"
               :fail-on-error nil
               ,@def-suite-args))
 
-(defmacro %in-suite (suite-name &rest def-suite-args &key fail-on-error &allow-other-keys)
-  (declare (ignore fail-on-error))
-  (with-gensyms (suite)
-    (let ((fail-on-error (getf def-suite-args :fail-on-error t)))
-      (remf def-suite-args :fail-on-error)
+(defmacro %in-suite (suite-name
+                     &key description (in nil in-p) (fixture nil fixture-p)
+                          (fail-on-error t))
+  (let ((def-suite-args
+          `(,@(when description `(:description ,description))
+            ,@(when in-p `(:in ',in))
+            ,@(when fixture-p `(:fixture ',fixture)))))
+    (with-gensyms (suite)
       `(progn
          (if-let (,suite (get-test ',suite-name))
            (setf *suite* ,suite)
            (progn
-             (when ,fail-on-error
-               (cerror "Create a new suite named ~A."
-                       "Unknown suite ~A." ',suite-name))
+             ,@(when fail-on-error
+                 `((cerror "Create a new suite named ~A."
+                           "Unknown suite ~A." ',suite-name)))
              (setf (get-test ',suite-name) (make-suite ',suite-name ,@def-suite-args)
                    *suite* (get-test ',suite-name))))
          ',suite-name))))