From f41aacc9b41270d2b0aef60a85aaf57f40131963 Mon Sep 17 00:00:00 2001 From: Andy Chambers Date: Sun, 4 Nov 2012 12:34:28 -0500 Subject: [PATCH] Add function list-all-suites --- src/package.lisp | 4 +++- src/suite.lisp | 13 ++++++++++--- t/tests.lisp | 4 ++++ 3 files changed, 17 insertions(+), 4 deletions(-) diff --git a/src/package.lisp b/src/package.lisp index 4183f11..2236081 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -72,7 +72,9 @@ #:*debug-on-error* #:*debug-on-failure* #:*verbose-failures* - #:results-status)) + #:results-status + ;; introspection + #:list-all-suites)) ;;;; You can use #+5am to put your test-defining code inline with your ;;;; other code - and not require people to have fiveam to run your 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) diff --git a/t/tests.lisp b/t/tests.lisp index 6bef836..0b95b8c 100644 --- a/t/tests.lisp +++ b/t/tests.lisp @@ -254,3 +254,7 @@ (for-all (((a b) (dummy-mv-generator))) (is (= 1 a)) (is (= 1 b)))) + +(def-test introspection () + (is (= (length (list-all-suites)) + (hash-table-count *suites*)))) \ No newline at end of file -- 1.7.10.4