anchor.diff:  
   ;;; Run the tests
   
  +(defclass test-result ()
  +  ((pass
  +    :type list
  +    :initarg :pass
  +    :reader pass)
  +   (fail
  +    :type list
  +    :initarg :fail
  +    :reader fail)
  +   (exerr
  +    :type condition
  +    :initarg :exerr
  +    :reader exerr))
  +  (:default-initargs :exerr nil)
  +  (:documentation
  +   "Store the results of the unit test."))
  +
   (defun run-code (code)
     "Run the code to test the assertions."
     (funcall (coerce `(lambda () ,@code) 'function)))
   
   (defun run-test-thunk (code)
  -  (let ((*pass* 0)
  -        (*fail* 0))
  +  (let ((*pass* ())
  +        (*fail* ()))
       (handler-bind
  -        ((error (lambda (condition)
  -                  (when *print-errors*
  -                    (print-error condition))
  -                  (if (use-debugger-p condition)
  -                      condition
  -                      (return-from run-test-thunk
  -                        (values *pass* *fail* condition))))))
  +        ((error
  +          (lambda (condition)
  +            (if (use-debugger-p condition)
  +                condition
  +                (return-from run-test-thunk
  +                  (make-instance
  +                   'test-result
  +                   :pass *pass*
  +                   :fail *fail*
  +                   :exerr condition))))))
         (run-code code))
       ;; Return the result count
  -    (values *pass* *fail* nil)))
  +    (make-instance 'test-result
  +                   :pass *pass*
  +                   :fail *fail*)))
   
   (defun %run-all-thunks (&optional (package *package*))
     "Run all of the test thunks in the package."
     (loop
  -   with results = (make-instance 'test-results)
  +   with results = (make-instance 'test-results-db)
      for test-name being each hash-key in (package-table package)
      using (hash-value unit-test)
      if unit-test do
  
positive.code: (defun print-summary (name pass fail &optional exerr)
    "Print a summary of the test results."
    (format t "~&~A: ~S assertions passed, ~S failed"
            name pass fail)
    (format t "~@[, ~S execution errors~].~2%" exerr))
  
  ;;; Global unit test database
  
negative.code:   `(lambda ()
       (list ,@(mapcan (lambda (form) (list `',form form)) extras))))
  
  (defclass assert-result ()
    ((form
      :initarg :form
      :reader form)
     (actual
      :type list
      :initarg :actual
      :reader actual)
     (expected
      :type list
      :initarg :expected
      :reader expected)
     (extras
      :type list
      :initarg :extras
      :reader extras)
     (test
      :type function
      :initarg :test
      :reader test)
     (passed
      :type boolean
      :reader passed))
    (:documentation
     "Result of the assertion."))
  
  (defmethod initialize-instance :after ((self assert-result)
                                         &rest initargs)
    "Evaluate the actual and expected forms"
    (with-slots (actual expected) self
      (setf
       actual (multiple-value-list (funcall actual))
       expected (multiple-value-list (funcall expected)))))
  
  (defclass equal-result (assert-result)
    ()
    (:documentation
     "Result of an equal assertion type."))
  
  (defmethod initialize-instance :after ((self equal-result)
                                         &rest initargs)
    "Return the result of the equality assertion."
    (with-slots (actual expected test passed) self
      (setf
       passed
       (and
        (<= (length expected) (length actual))
        (every test expected actual)))))
  
  (defclass error-result (assert-result)
    ()
    (:documentation
     "Result of an error assertion type."))
  
  (defmethod initialize-instance :after ((self error-result)
                                         &rest initargs)
    "Evaluate the result."
    (with-slots (actual expected passed) self
      (setf
       passed
       (or
        (eql (car actual) (car expected))
        (typep (car actual) (car expected))))))
  
  (defclass macro-result (assert-result)
    ()
    (:documentation
     "Result of a macro assertion type."))
  
  (defmethod initialize-instance :after ((self macro-result)
                                         &rest initargs)
    "Return the result of the macro expansion."
    (with-slots (actual expected passed) self
      (setf passed (equal (car actual) (car expected)))))
  
  (defclass boolean-result (assert-result)
    ()
    (:documentation
     "Result of a result assertion type."))
  
  (defmethod initialize-instance :after ((self boolean-result)
                                         &rest initargs)
    "Return the result of the assertion."
    (with-slots (actual expected passed) self
      (setf passed (logically-equal (car actual) (car expected)))))
  
  (defclass output-result (assert-result)
    ()
    (:documentation
     "Result of an output assertion type."))
  
  (defmethod initialize-instance :after ((self output-result)
                                         &rest initargs)
    "Return the result of the printed output."
    (with-slots (actual expected passed) self
      (setf
       passed
       (string=
        (string-trim '(#\newline #\return #\space) (car actual))
        (car expected)))))
  
  (defun assert-class (type)
    "Return the class name for the assertion type."
    (ecase type
      (:equal 'equal-result)
      (:error 'error-result)
      (:macro 'macro-result)
      (:result 'boolean-result)
      (:output 'output-result)))
  
  (defun internal-assert
         (type form code-thunk expected-thunk extras test)
    "Perform the assertion and record the results."
    (let ((result
           (make-instance (assert-class type)
                          :form form
                          :actual code-thunk
                          :expected expected-thunk
                          :extras extras
                          :test test)))
      (if (passed result)
          (push result *pass*)
          (push result *fail*))
      ;; Return the result
      (passed result)))
  
  ;;; Results
  
  (defclass test-results-db ()
    ((database
      :type hash-table
      :initform (make-hash-table :test #'eq)
      :reader database)
     (pass
      :type fixnum
      :initform 0
  