anchor.diff:  	(setf r
   	      (flet ((%do
   		      ()
  -		      (if *compile-tests*
  -			  (multiple-value-list
  -			   (funcall (compile
  -				     nil
  -				     `(lambda ()
  -					(declare
  -					 (optimize ,@*optimization-settings*))
  -					,(form entry)))))
  +		      (cond
  +		       (*compile-tests*
   			(multiple-value-list
  -			 (eval (form entry))))))
  +			 (funcall (compile
  +				   nil
  +				   `(lambda ()
  +				      (declare
  +				       (optimize ,@*optimization-settings*))
  +				      ,(form entry))))))
  +		       (*expanded-eval*
  +			(multiple-value-list
  +			 (expanded-eval (form entry))))
  +		       (t
  +			(multiple-value-list
  +			 (eval (form entry)))))))
   		(if *catch-errors*
   		    (handler-bind
  -			((style-warning #'muffle-warning)
  -			 (error #'(lambda (c)
  -				    (setf aborted t)
  -				    (setf r (list c))
  -				    (return-from aborted nil))))
  -		      (%do))
  +		     (#-ecl (style-warning #'muffle-warning)
  +			    (error #'(lambda (c)
  +				       (setf aborted t)
  +				       (setf r (list c))
  +				       (return-from aborted nil))))
  +		     (%do))
   		  (%do)))))
   
         (setf (pend entry)
   	    (or aborted
   		(not (equalp-with-case r (vals entry)))))
         
  -      (when (and (pend entry) *print-failed-test-cases*)
  +      (when (pend entry)
   	(let ((*print-circle* *print-circle-on-failure*))
   	  (format s "~&Test ~:@(~S~) failed~
                      ~%Form: ~S~
  
positive.code: 	  (stream out :direction :output)
  	(do-entries stream))))
  
  (defun do-entries (s)
    (format s "~&Doing ~A pending test~:P ~
               of ~A tests total.~%"
            (count t (cdr *entries*)
  		 :key #'pend)
  	  (length (cdr *entries*)))
    (dolist (entry (cdr *entries*))
      (when (pend entry)
        (format s "~@[~<~%~:; ~:@(~S~)~>~]"
  	      (do-entry entry s))))
    (let ((pending (pending-tests))
  	(expected-table (make-hash-table :test #'equal)))
      (dolist (ex *expected-failures*)
  
negative.code: 	   #:rem-all-tests #:rem-test)
    (:documentation "The MIT regression tester with pfdietz's modifications"))
  
  ;;This was the December 19, 1990 version of the regression tester, but
  ;;has since been modified.
  
  (in-package :regression-test)
  
  (declaim (ftype (function (t) t) get-entry expanded-eval do-entries))
  (declaim (type list *entries*))
  (declaim (ftype (function (t &rest t) t) report-error))
  (declaim (ftype (function (t &optional t) t) do-entry))
  
  (defvar *test* nil "Current test name")
  (defvar *do-tests-when-defined* nil)
  (defvar *entries* '(nil) "Test database.  Has a leading dummy cell that does not contain an entry.")
  (defvar *entries-tail* *entries* "Tail of the *entries* list")
  (defvar *entries-table* (make-hash-table :test #'equal)
      "Map the names of entries to the cons cell in *entries* that precedes the one whose car is the entry.")
  (defvar *in-test* nil "Used by TEST")
  (defvar *debug* nil "For debugging")
  (defvar *catch-errors* t "When true, causes errors in a test to be caught.")
  (defvar *print-circle-on-failure* nil
    "Failure reports are printed with *PRINT-CIRCLE* bound to this value.")
  
  (defvar *compile-tests* nil "When true, compile the tests before running them.")
  (defvar *expanded-eval* nil "When true, convert the tests into a form that is less likely to have compiler optimizations.")
  (defvar *optimization-settings* '((safety 3)))
  
  (defvar *expected-failures* nil
    "A list of test names that are expected to fail.")
  
  (defvar *notes* (make-hash-table :test 'equal)
    "A mapping from names of notes to note objects.")
    
  (defstruct (entry (:conc-name nil))
    pend name props form vals)
  
  ;;; Note objects are used to attach information to tests.
  ;;; A typical use is to mark tests that depend on a particular
  ;;; part of a set of requirements, or a particular interpretation
  ;;; of the requirements.
  
  (defstruct note
    name  
    contents
    disabled ;; When true, tests with this note are considered inactive
    )
  
  ;; (defmacro vals (entry) `(cdddr ,entry))
  
  (defmacro defn (entry)
    (let ((var (gensym)))
      `(let ((,var ,entry))
         (list* (name ,var) (form ,var) (vals ,var)))))
  
  (defun entry-notes (entry)
    (let* ((props (props entry))
  	 (notes (getf props :notes)))
      (if (listp notes)
  	notes
        (list notes))))
  
  (defun has-disabled-note (entry)
    (let ((notes (entry-notes entry)))
      (loop for n in notes
  	  for note = (if (note-p n) n
  		       (gethash n *notes*))
  	  thereis (and note (note-disabled note)))))
  
  (defun pending-tests ()
    (loop for entry in (cdr *entries*)
  	when (and (pend entry) (not (has-disabled-note entry)))
  	collect (name entry)))
  
  (defun rem-all-tests ()
    (setq *entries* (list nil))
    (setq *entries-tail* *entries*)
    (clrhash *entries-table*)
    nil)
  
  (defun rem-test (&optional (name *test*))
    (let ((pred (gethash name *entries-table*)))
      (when pred
        (if (null (cddr pred))
  	  (setq *entries-tail* pred)
  	(setf (gethash (name (caddr pred)) *entries-table*) pred))
        (setf (cdr pred) (cddr pred))
        (remhash name *entries-table*)
        name)))
  
  (defun get-test (&optional (name *test*))
    (defn (get-entry name)))
  
  (defun get-entry (name)
    (let ((entry ;; (find name (the list (cdr *entries*))
  	       ;;     :key #'name :test #'equal)
  	 (cadr (gethash name *entries-table*))
  	 ))
      (when (null entry)
        (report-error t
          "~%No test with name ~:@(~S~)."
  	name))
      entry))
  
  (defmacro deftest (name &rest body)
    (let* ((p body)
  	 (properties
  	  (loop while (keywordp (first p))
  		unless (cadr p)
  		do (error "Poorly formed deftest: ~A~%"
  			  (list* 'deftest name body))
  		append (list (pop p) (pop p))))
  	 (form (pop p))
  	 (vals p))
      `(add-entry (make-entry :pend t
  			    :name ',name
  			    :props ',properties
  			    :form ',form
  			    :vals ',vals))))
  
  (defun add-entry (entry)
    (setq entry (copy-entry entry))
    (let* ((pred (gethash (name entry) *entries-table*)))
      (cond
       (pred
        (setf (cadr pred) entry)
        (report-error nil
          "Redefining test ~:@(~S~)"
          (name entry)))
       (t
        (setf (gethash (name entry) *entries-table*) *entries-tail*)
        (setf (cdr *entries-tail*) (cons entry nil))
        (setf *entries-tail* (cdr *entries-tail*))
        )))
    (when *do-tests-when-defined*
      (do-entry entry))
    (setq *test* (name entry)))
  