X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fsuite.lisp;h=b97c94c5a38cc45f44794bf1d1cfe2cf297eca82;hb=f41aacc9b41270d2b0aef60a85aaf57f40131963;hp=972e1f659df9be82d2f318aba1cb3ef42e741911;hpb=b76fc6a27dc451c7f2f88eb9a1f028228530af6c;p=fiveam.git

diff --git a/src/suite.lisp b/src/suite.lisp
index 972e1f6..b97c94c 100644
--- a/src/suite.lisp
+++ b/src/suite.lisp
@@ -16,6 +16,8 @@
 
 ;;;; ** Creating Suits
 
+(defvar *suites* (make-hash-table))
+
 (defmacro def-suite (name &key description in)
   "Define a new test-suite named NAME.
 
@@ -24,9 +26,10 @@ 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."
   `(eval-when (:compile-toplevel :load-toplevel :execute)
-     (make-suite ',name
-                 ,@(when description `(:description ,description))
-                 ,@(when in `(:in ',in)))
+     (setf (gethash ',name *suites*)
+           (make-suite ',name
+                       ,@(when description `(:description ,description))
+                       ,@(when in `(:in ',in))))
      ',name))
 
 (defmacro def-suite* (name &rest def-suite-args)
@@ -52,6 +55,10 @@ Overrides any existing suite named NAME."
     (setf (get-test name) suite)
     suite))
 
+(defun list-all-suites ()
+  (loop for suite being the hash-value in *suites*
+       collect suite))
+
 ;;;; ** Managing the Current Suite
 
 (defvar *suite* (setf (get-test 'NIL)