From: Thomas M. Hermann <thomas.m.hermann@odonata-research.com>
Date: Sun, 14 Oct 2012 22:47:52 +0000 (-0500)
Subject: Merge branch 'devel-0.9.0'
X-Git-Tag: 0.9.0~1
X-Git-Url: https://repo.or.cz/w/lisp-unit.git/commitdiff_plain/65f1169ae22cce46ba60b44ccbb2b126b6452307

Merge branch 'devel-0.9.0'

Conflicts:
	lisp-unit.lisp
---

65f1169ae22cce46ba60b44ccbb2b126b6452307
diff --cc lisp-unit.lisp
index 569e5da,350d561..e021251
--- a/lisp-unit.lisp
+++ b/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)