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: 	   #:rem-all-tests #:rem-test)
    (:documentation "The MIT regression tester with pfdietz's modifications"))
  
  (in-package :regression-test)
  
  (defvar *test* nil "Current test name")
  (defvar *do-tests-when-defined* nil)
  (defvar *entries* '(nil) "Test database")
  (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 *optimization-settings* '((safety 3)))
  (defvar *expected-failures* nil
    "A list of test names that are expected to fail.")
  (defvar *print-failed-test-cases* nil
    "When true, print information about failed test cases.")
  
  (defstruct (entry (:conc-name nil)
  		  (:type list))
    pend name form)
  
  (defmacro vals (entry) `(cdddr ,entry))
  
  (defmacro defn (entry) `(cdr ,entry))
  
  (defun pending-tests ()
    (do ((l (cdr *entries*) (cdr l))
         (r nil))
        ((null l) (nreverse r))
      (when (pend (car l))
        (push (name (car l)) r))))
  
  (defun rem-all-tests ()
    (setq *entries* (list nil))
    nil)
  
  (defun rem-test (&optional (name *test*))
    (do ((l *entries* (cdr l)))
        ((null (cdr l)) nil)
      (when (equal (name (cadr l)) name)
        (setf (cdr l) (cddr l))
        (return name))))
  
  (defun get-test (&optional (name *test*))
    (defn (get-entry name)))
  
  (defun get-entry (name)
    (let ((entry (find name (cdr *entries*)
  		     :key #'name
  		     :test #'equal)))
      (when (null entry)
        (report-error t
          "~%No test with name ~:@(~S~)."
  	name))
      entry))
  
  (defmacro deftest (name form &rest values)
    `(add-entry '(t ,name ,form .,values)))
  
  (defun add-entry (entry)
    (setq entry (copy-list entry))
    (do ((l *entries* (cdr l))) (nil)
      (when (null (cdr l))
        (setf (cdr l) (list entry))
        (return nil))
      (when (equal (name (cadr l)) 
  		 (name entry))
        (setf (cadr l) entry)
        (report-error nil
          "Redefining test ~:@(~S~)"
          (name entry))
        (return nil)))
    (when *do-tests-when-defined*
      (do-entry entry))
    (setq *test* (name entry)))
  
negative.code: 		  *test* (form entry)
  		  (length (vals entry))
  		  (vals entry))
  	  (handler-case
  	   (let ((st (format nil "Actual value~P: ~
                        ~{~S~^~%~15t~}.~%"
  			    (length r) r)))
  	     (format s "~A" st))
  	   (error () (format s "Actual value: #<error during printing>~%")
  		  ))
  	  (finish-output s)
  	  ))))
    (when (not (pend entry)) *test*))
  
  (defun expanded-eval (form)
    "Split off top level of a form and eval separately.  This reduces the chance that
     compiler optimizations will fold away runtime computation."
    (if (not (consp form))
        (eval form)
     (let ((op (car form)))
       (cond
        ((eq op 'let)
         (let* ((bindings (loop for b in (cadr form)
  			      collect (if (consp b) b (list b nil))))
  	      (vars (mapcar #'car bindings))
  	      (binding-forms (mapcar #'cadr bindings)))
  	 (apply
  	  (the function
  	    (eval `(lambda ,vars ,@(cddr form))))
  	  (mapcar #'eval binding-forms))))
        ((and (eq op 'let*) (cadr form))
         (let* ((bindings (loop for b in (cadr form)
  			      collect (if (consp b) b (list b nil))))
  	      (vars (mapcar #'car bindings))
  	      (binding-forms (mapcar #'cadr bindings)))
  	 (funcall
  	  (the function
  	    (eval `(lambda (,(car vars) &aux ,@(cdr bindings)) ,@(cddr form))))
  	  (eval (car binding-forms)))))
        ((eq op 'progn)
         (loop for e on (cdr form)
  	     do (if (null (cdr e)) (return (eval (car e)))
  		  (eval (car e)))))
        ((and (symbolp op) (fboundp op)
  	    (not (macro-function op))
  	    (not (special-operator-p op)))
         (apply (symbol-function op)
  	      (mapcar #'eval (cdr form))))
        (t (eval form))))))
  
  (defun continue-testing ()
    (if *in-test*
  