Signal an error if no tests are defined in the package.
authorThomas M. Hermann <thomas.m.hermann@odonata-research.com>
Fri, 15 Mar 2013 01:52:48 +0000 (14 20:52 -0500)
committerThomas M. Hermann <thomas.m.hermann@odonata-research.com>
Fri, 15 Mar 2013 01:52:48 +0000 (14 20:52 -0500)
Also clean up warning messages for test-documentation and test-code.

extensions/floating-point.lisp
lisp-unit.lisp

index 435c44e..3df2b06 100644 (file)
   the Definition 1.3 in [NumAlgoC] for cases when either the exact
   or the approximate value equals zero. According to Definition 1.3,
   the relative error is identically equal to 1 in those cases. This
-  function returns the absolue error in those cases. This is more
+  function returns the absolute error in those cases. This is more
   useful for testing.
 |#
 (defun %relative-error (exact approximate)
index 196c0b9..97e64e8 100644 (file)
@@ -154,7 +154,8 @@ assertion.")
    ((gethash (find-package package) *test-db*))
    (create
     (setf (gethash package *test-db*) (make-hash-table)))
-   (t (warn "No tests defined for package: ~S" package))))
+   (t (error "No tests defined for package ~A."
+             (package-name package)))))
 
 ;;; Global tags database
 
@@ -167,7 +168,8 @@ assertion.")
    ((gethash (find-package package) *tag-db*))
    (create
     (setf (gethash package *tag-db*) (make-hash-table)))
-   (t (warn "No tags defined for package: ~S" package))))
+   (t (error "No tags defined for package ~A."
+             (package-name package)))))
 
 ;;; Unit test definition
 
@@ -246,16 +248,16 @@ assertion.")
   "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)
+        (warn "No test ~A in package ~A."
+              name (package-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)
+        (warn "No test ~A in package ~A."
+              name (package-name package))
         (code unit-test))))
 
 (defun remove-tests (names &optional (package *package*))