From 9aa957976bf21ec5635171f5f34e6b236e77923e Mon Sep 17 00:00:00 2001 From: "Thomas M. Hermann" Date: Thu, 14 Mar 2013 20:52:48 -0500 Subject: [PATCH] Signal an error if no tests are defined in the package. Also clean up warning messages for test-documentation and test-code. --- extensions/floating-point.lisp | 2 +- lisp-unit.lisp | 14 ++++++++------ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/extensions/floating-point.lisp b/extensions/floating-point.lisp index 435c44e..3df2b06 100644 --- a/extensions/floating-point.lisp +++ b/extensions/floating-point.lisp @@ -157,7 +157,7 @@ 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) diff --git a/lisp-unit.lisp b/lisp-unit.lisp index 196c0b9..97e64e8 100644 --- a/lisp-unit.lisp +++ b/lisp-unit.lisp @@ -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*)) -- 2.11.4.GIT