anchor.diff:    "Signal the results for extensibility."
     (setq *signal-results* flag))
   
  +;;; Utility
  +
  +(defun print-warning (warning &optional (stream *error-output*))
  +  "May want to handle the warning with HANDLER-CASE."
  +  (format stream "~&Warning: ~A~&" warning))
  +
   ;;; Global unit test database
   
   (defparameter *test-db* (make-hash-table :test #'eq)
     "The unit test database is simply a hash table.")
  +
  +(defun null-tests-warning-report (null-tests-warning stream)
  +  "Write the null-tests-warning to the stream."
  +  (format stream "No tests defined for package ~A."
  +          (tests-package-name null-tests-warning)))
  +
  +(define-condition null-tests-warning (simple-warning)
  +  ((name
  +    :type string
  +    :initarg :name
  +    :reader tests-package-name))
  +  (:report null-tests-warning-report))
   
   (defun package-table (package &optional create)
     (cond
      ((gethash (find-package package) *test-db*))
      (create
       (setf (gethash package *test-db*) (make-hash-table)))
  -   (t (error "No tests defined for package ~A."
  -             (package-name package)))))
  +   (t (warn 'null-tests-warning :name (package-name package)))))
  +
  +(defmacro with-package-table ((table
  +                               &optional (package *package*) create)
  +                              &body body)
  +  "Execute the body only if the package table exists."
  +  (let ((gtable (gensym "TABLE-")))
  +    `(let* ((,gtable (package-table ,package ,create))
  +            (,table ,gtable))
  +       (when (hash-table-p ,gtable) ,@body))))
   
   ;;; Global tags database
   
   (defparameter *tag-db* (make-hash-table :test #'eq)
     "The tag database is simply a hash table.")
  +
  +(defun null-tags-warning-report (null-tags-warning stream)
  +  "Write the null-tags-warning to the stream."
  +  (format stream "No tags defined for package ~A."
  +          (tags-package-name null-tags-warning)))
  +
  +(define-condition null-tags-warning (simple-warning)
  +  ((name
  +    :type string
  +    :initarg :name
  +    :reader tags-package-name))
  +  (:report null-tags-warning-report))
   
   (defun package-tags (package &optional create)
     "Return the tags DB for the package."
  
positive.code:       (if (null package)
            (clrhash *tag-db*)
            (remhash (find-package package) *tag-db*))
        (let ((table (package-tags package)))
          (unless (null table)
            (loop for tag in tags
                  unless (remhash tag table) do
                  (warn "No tag ~A in package ~A to remove."
  
negative.code: 
  (defun %run-all-thunks (&optional (package *package*))
    "Run all of the test thunks in the package."
    (with-package-table (table package)
      (loop
       with results = (make-instance 'test-results-db)
       for test-name being each hash-key in table
       using (hash-value unit-test)
       if unit-test do
       (record-result test-name (code unit-test) results)
       else do
       (push test-name (missing-tests results))
       ;; Summarize and return the test results
       finally
       (when *signal-results*
         (signal 'test-run-complete :results results))
       (summarize-results results)
       (return results))))
  
  (defun %run-thunks (test-names &optional (package *package*))
    "Run the list of test thunks in the package."
    (with-package-table (table package)
      (loop
       with results = (make-instance 'test-results-db)
       for test-name in test-names
       as unit-test = (gethash test-name table)
       if unit-test do
       (record-result test-name (code unit-test) results)
       else do
       (push test-name (missing-tests results))
       finally
       (when *signal-results*
         (signal 'test-run-complete :results results))
       (summarize-results results)
       (return results))))
  
  (defun run-tests (&optional (test-names :all) (package *package*))
    "Run the specified tests in package."
  