anchor.diff:    `(lambda ()
        (list ,@(mapcan (lambda (form) (list `',form form)) extras))))
   
  +(defun internal-assert
  +       (type form code-thunk expected-thunk extras test)
  +  (let ((expected (multiple-value-list (funcall expected-thunk)))
  +        (actual (multiple-value-list (funcall code-thunk)))
  +        (passed nil))
  +    ;; Count the assertion
  +    (if (setq passed (test-passed-p type expected actual test))
  +        (incf *pass*)
  +        (incf *fail*))
  +    ;; Report the assertion
  +    (when (and *report-results* (not passed))
  +      (report-failure type form expected actual extras))
  +    ;; Return the result
  +    passed))
  +
  +;;; Test passed predicate.
  +
  +(defgeneric test-passed-p (type expected actual test)
  +  (:documentation
  +   "Return the result of the test."))
  +
  +(defmethod test-passed-p ((type (eql :error)) expected actual test)
  +  "Return the result of the error assertion."
  +  (or
  +   (eql (car actual) (car expected))
  +   (typep (car actual) (car expected))))
  +
  +(defmethod test-passed-p ((type (eql :equal)) expected actual test)
  +  "Return the result of the equality assertion."
  +  (and
  +   (<= (length expected) (length actual))
  +   (every test expected actual)))
  +
  +(defmethod test-passed-p ((type (eql :macro)) expected actual test)
  +  "Return the result of the macro expansion."
  +  (equal (car actual) (car expected)))
  +
  +(defmethod test-passed-p ((type (eql :output)) expected actual test)
  +  "Return the result of the printed output."
  +  (string=
  +   (string-trim '(#\newline #\return #\space) (car actual))
  +   (car expected)))
  +
  +(defmethod test-passed-p ((type (eql :result)) expected actual test)
  +  "Return the result of the assertion."
  +  (logically-equal (car actual) (car expected)))
  +
  +;;; Failure control strings for reports.
  +
  +(defgeneric failure-control-string (type)
  +  (:method (type)
  +   "~&Expected ~{~S~^; ~} ~<~%~:;but saw ~{~S~^; ~}~>")
  +  (:documentation
  +   "Return the FORMAT control string for the failure type."))
  +
  +(defmethod failure-control-string ((type (eql :error)))
  +  "~&~@[Should have signalled ~{~S~^; ~} but saw~] ~{~S~^; ~}")
  +
  +(defmethod failure-control-string ((type (eql :macro)))
  +  "~&Should have expanded to ~{~S~^; ~} ~<~%~:;but saw ~{~S~^; ~}~>")
  +
  +(defmethod failure-control-string ((type (eql :output)))
  +  "~&Should have printed ~{~S~^; ~} ~<~%~:;but saw ~{~S~^; ~}~>")
  +
  +;;; Reports
  +
  +(defun report-failure (type form expected actual extras)
  +  "Report the details of the failure assertion."
  +  (format t "Failed Form: ~S" form)
  +  (format t (failure-control-string type) expected actual)
  +  (when extras
  +    (format t "~{~&   ~S => ~S~}~%" (funcall extras)))
  +  type)
  +
  +(defun report-summary (name pass fail &optional exerr)
  +  (format t "~&~A: ~S assertions passed," name pass)
  +  (format t " ~S failed~@[, ~S execution errors~]." fail exerr))
  +
   ;;; RUN-TESTS
   
  -(defun run-all-tests (&optional (package *package*))
  -  "Run all of the tests in package."
  -  (run-tests :all package))
  -
  -(defun run-tests (names &optional (package *package*))
  +(defclass test-results ()
  +  ((test-names
  +    :type list
  +    :initarg :test-names
  +    :reader test-names)
  +   (successful-assertions
  +    :type fixnum
  +    :initform 0
  +    :accessor successful-assertions)
  +   (failed-assertions
  +    :type fixnum
  +    :initform 0
  +    :accessor failed-assertions)
  +   (execution-errors
  +    :type fixnum
  +    :initform 0
  +    :accessor execution-errors)
  +   (failed-tests
  +    :type list
  +    :initform ()
  +    :reader failed-tests)
  +   (error-tests
  +    :type list
  +    :initform ()
  +    :reader error-tests)
  +   (missing-tests
  +    :type list
  +    :initform ()
  +    :reader missing-tests))
  +  (:default-initargs :test-names ())
  +  (:documentation
  +   "Store the results of the tests for further evaluation."))
  +
  +(defmacro run-code (code)
  +  "Wrap the code in a lambda and FUNCALL it."
  +  `(funcall (lambda () ,@code)))
  +
  +(defun use-debugger-p (e)
  +  (and *use-debugger*
  +       (or (not (eql *use-debugger* :ask))
  +           (y-or-n-p "~A -- debug?" e))))
  +
  +(defun run-test-thunk (code)
  +  (let ((*pass* 0)
  +        (*fail* 0))
  +    (declare (special *pass* *fail*))
  +    (handler-case (run-code code)
  +      (error (condition)
  +        (if (use-debugger-p condition)
  +            condition
  +            (return (values *pass* *fail* :error)))))
  +    ;; Return the result count
  +    (values *pass* *fail* nil)))
  +
  +(defun %run-all-thunks (&optional (package *package*))
  +  "Run all of the test thunks in the package."
  +  (loop
  +   with results = (make-instance 'test-results)
  +   for test-name being each hash-key in (package-table package)
  +   using (hash-value code)
  +   if code do
  +   (multiple-value-bind (pass fail exerr)
  +       (run-test-thunk test-name code)
  +     (push test-name (test-names results))
  +     ;; Count passed tests
  +     (when (plusp pass)
  +       (incf (successful-assertions results) pass))
  +     ;; Count failed tests and record name
  +     (when (plusp fail)
  +       (incf (failed-assertions results) fail)
  +       (push test-name (failed-tests results)))
  +     ;; Count errors and record name
  +     (when (eq :error exerr)
  +       (incf (execution-errors results))
  +       (push test-name (error-tests results))))
  +   else do
  +   (push test-name (missing-tests results))
  +   ;; Return the test results
  +   finally (return results)))
  +
  +(defun run-tests (test-names &optional (package *package*))
     "Run the specified tests in package."
  -  (run-test-thunks
  -   (if (eq :all names)
  -       (get-test-thunks (get-tests package) package)
  -       (get-test-thunks names package))))
  +  (if (eq :all test-names)
  +      (%run-all-thunks package)
  +      (%run-thunks test-names package)))
   
   (defun get-test-thunks (names &optional (package *package*))
     (loop for name in names collect
  
positive.code:    :run-tests :run-all-tests
     :use-debugger
     :with-test-listener)
    ;; Forms for assertions
    (:export
     :assert-eq :assert-eql :assert-equal :assert-equalp
     :assert-equality :assert-prints :assert-expands
     :assert-true :assert-false :assert-error)
    ;; Utility predicates
    (:export
     :logically-equal :set-equal))
  
  (in-package :lisp-unit)
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;; Globals
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (defparameter *test-listener* nil)
  
  (defparameter *tests* (make-hash-table))
  
  ;;; Used by RUN-TESTS to collect summary statistics
  (defvar *test-count* 0)
  (defvar *pass-count* 0)
  
  ;;; Set by RUN-TESTS for use by SHOW-FAILURE
  (defvar *test-name* nil)
  
  ;;; If nil, errors in tests are caught and counted.
  ;;; If :ask, user is given option of entering debugger or not.
  ;;; If true and not :ask, debugger is entered.
  (defparameter *use-debugger* nil)
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;; Macros
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  ;;; DEFINE-TEST
  
  (defmacro define-test (name &body body)
    `(progn
       (store-test-code ',name ',body)
       ',name))
  
  ;;; ASSERT macros
  
  (defmacro assert-eq (expected form &rest extras)
    "Assert whether expected and form are EQ."
  
negative.code:         exit
          (return (values *test-count* *pass-count* error-count)))))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;; Public functions
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (defun get-test-code (name &optional (package *package*))
    (let ((table (get-package-table package)))
      (unless (null table)
        (code (gethash name table)))))
  
  (defun get-tests (&optional (package *package*))
    (loop for key being each hash-key in (get-package-table package)
          collect key))
  
  (defun remove-tests (names &optional (package *package*))
    (let ((table (get-package-table package)))
      (unless (null table)
        (if (eq :all names)
            (clrhash table)
            (loop for name in names always
                  (remhash name table))))))
  
  (defun remove-all-tests (&optional (package *package*))
    (if (null package)
        (clrhash *tests*)
        (remhash (find-package package) *tests*)))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;; Private functions
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  ;;; DEFINE-TEST support
  
  ;;; ASSERTION support
  
  (defclass test-results ()
    ((tests
      :type list
      :initarg :tests
      :reader tests)
     (total-assertions
      :type fixnum
      :initform 0
      :accessor total-assertions)
     (successful-assertions
      :type fixnum
      :initform 0
      :accessor successful-assertions)
     (failed-assertions
      :type fixnum
      :initform 0
      :accessor failed-assertions)
     (execution-errors
      :type fixnum
      :initform 0
      :accessor execution-errors)
     (failed-tests
      :type list
      :initform ()
      :reader failed-tests)
     (error-tests
      :type list
      :initform ()
      :reader error-tests))
    (:documentation
     "Store the results of the tests for further evaluation."))
  
  (defun record-result (passed type form expected actual extras)
    (funcall (or *test-listener* 'default-listener)
             passed type *test-name* form expected actual 
             (and extras (funcall extras))
             *test-count* *pass-count*))
  
  (defun default-listener
         (passed type name form expected actual extras test-count pass-count)
    (declare (ignore test-count pass-count))
    (unless passed
      (show-failure type (get-failure-message type)
                    name form expected actual extras)))
  
  ;;; OUTPUT support
  
  (defun collect-form-values (form values)
    (mapcan (lambda (form-arg value)
  