Merge branch 'devel-0.9.0'
authorThomas M. Hermann <thomas.m.hermann@odonata-research.com>
Sun, 14 Oct 2012 22:47:52 +0000 (14 17:47 -0500)
committerThomas M. Hermann <thomas.m.hermann@odonata-research.com>
Sun, 14 Oct 2012 22:47:52 +0000 (14 17:47 -0500)
Conflicts:
lisp-unit.lisp

1  2 
lisp-unit.lisp

diff --cc lisp-unit.lisp
@@@ -167,19 -223,44 +223,48 @@@ assertion."
  
  (defmacro define-test (name &body body)
    "Store the test in the test database."
-   `(progn
-      (setf
-       (gethash ',name (package-table *package* t))
-       ',body)
-      ;; Return the name of the test
-      ',name))
- ;;; Remove tests from the test DB
+   (multiple-value-bind (doc tag code) (parse-body body)
+     `(progn
+        (setf
+         ;; Unit test
+         (gethash ',name (package-table *package* t))
+         (make-instance 'unit-test :doc ,doc :code ',code))
+        ;; Tags
+        (loop for tag in ',tag do
+              (pushnew
+               ',name (gethash tag (package-tags *package* t))))
+        ;; Return the name of the test
+        ',name)))
+ ;;; Manage tests
+ (defun list-tests (&optional (package *package*))
+   "Return a list of the tests in package."
+   (let ((table (package-table package)))
+     (when table
+       (loop for test-name being each hash-key in table
+             collect test-name))))
+ (defun test-documentation (name &optional (package *package*))
+   "Return the documentation for the test."
+   (let ((unit-test (gethash name (package-table package))))
+     (if (null unit-test)
+         (warn "No code defined for test ~A in package ~S."
+               name package)
+         (doc unit-test))))
+ (defun test-code (name &optional (package *package*))
+   "Returns the code stored for the test name."
+   (let ((unit-test (gethash name (package-table package))))
+     (if (null unit-test)
+         (warn "No code defined for test ~A in package ~S."
+               name package)
+         (code unit-test))))
  
 +;;; 0.8.1 Compatibility revision for Quicklisp
 +(defun remove-all-tests (&optional (package *package*))
 +  (remove-tests :all package))
 +
  (defun remove-tests (names &optional (package *package*))
    "Remove individual tests or entire sets."
    (if (eq :all names)