diff --git a/debian/changelog b/debian/changelog
index f2ca802127e9b193f2015afac50b202eb5afd724..03108113d36cd8d2b9222a6ec08fc6c385d36e95 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-rt (20040621-1) unstable; urgency=low
+
+  * New upstream from Paul Dietz's ansi-tests
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon, 21 Jun 2004 15:27:33 -0600
+
 cl-rt (20030428b-1) unstable; urgency=low
 
   * Fix dos line endings
diff --git a/rt-original.lisp b/rt-original.lisp
deleted file mode 100644
index b24ecf1adac7b3910cae70f0ee02e99b4a5a4228..0000000000000000000000000000000000000000
--- a/rt-original.lisp
+++ /dev/null
@@ -1,167 +0,0 @@
-;-*-syntax:COMMON-LISP;Package:(RT :use "COMMON-LISP" :colon-mode :external)-*-
-
-#|----------------------------------------------------------------------------|
- | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
- |                                                                            |
- | Permission  to  use,  copy, modify, and distribute this software  and  its |
- | documentation for any purpose  and without fee is hereby granted, provided |
- | that this copyright  and  permission  notice  appear  in  all  copies  and |
- | supporting  documentation,  and  that  the  name  of M.I.T. not be used in |
- | advertising or  publicity  pertaining  to  distribution  of  the  software |
- | without   specific,   written   prior   permission.      M.I.T.  makes  no |
- | representations  about  the  suitability of this software for any purpose. |
- | It is provided "as is" without express or implied warranty.                |
- |                                                                            |
- |  M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,  INCLUDING  |
- |  ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL  |
- |  M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL  DAMAGES  OR  |
- |  ANY  DAMAGES  WHATSOEVER  RESULTING  FROM  LOSS OF USE, DATA OR PROFITS,  |
- |  WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER  TORTIOUS  ACTION,  |
- |  ARISING  OUT  OF  OR  IN  CONNECTION WITH THE USE OR PERFORMANCE OF THIS  |
- |  SOFTWARE.                                                                 |
- |----------------------------------------------------------------------------|#
-
-;This is the December 19, 1990 version of the regression tester.
-
-(defpackage #:rt
-  (:use #:common-lisp)
-  (:export deftest get-test do-test rem-test
-           rem-all-tests do-tests pending-tests
-           continue-testing *test*
-           *do-tests-when-defined*))
-(in-package :rt)
-(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")
-
-(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)))
-
-(defun report-error (error? &rest args)
-  (cond (*debug* 
-	 (apply #'format t args)
-	 (if error? (throw '*debug* nil)))
-	(error? (apply #'error args))
-	(t (apply #'warn args))))
-
-(defun do-test (&optional (name *test*))
-  (do-entry (get-entry name)))
-
-(defun do-entry (entry &optional
-		 (s *standard-output*))
-  (catch '*in-test*
-    (setq *test* (name entry))
-    (setf (pend entry) t)
-    (let* ((*in-test* t)
-           (*break-on-warnings* t)
-	   (r (multiple-value-list
-		(eval (form entry)))))
-      (setf (pend entry)
-	    (not (equal r (vals entry))))
-      (when (pend entry)
-	(format s "~&Test ~:@(~S~) failed~
-                   ~%Form: ~S~
-                   ~%Expected value~P: ~
-                      ~{~S~^~%~17t~}~
-                   ~%Actual value~P: ~
-                      ~{~S~^~%~15t~}.~%"
-		*test* (form entry)
-		(length (vals entry))
-		(vals entry)
-		(length r) r))))
-      (when (not (pend entry)) *test*))
-
-(defun continue-testing ()
-  (if *in-test*
-      (throw '*in-test* nil)
-      (do-entries *standard-output*)))
-
-(defun do-tests (&optional
-		 (out *standard-output*))
-  (dolist (entry (cdr *entries*))
-    (setf (pend entry) t))
-  (if (streamp out)
-      (do-entries out)
-      (with-open-file 
-	  (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)))
-    (if (null pending)
-	(format s "~&No tests failed.")
-	(format s "~&~A out of ~A ~
-                   total tests failed: ~
-                   ~:@(~{~<~%   ~1:;~S~>~
-                         ~^, ~}~)."
-		(length pending)
-		(length (cdr *entries*))
-		pending))
-    (null pending)))
diff --git a/rt.lisp b/rt.lisp
index d4dd2aedb677e020169363f312f6da7fe1c8317e..dabd075f4085dc5fbe39db0408c3b62cdf02334e 100644
--- a/rt.lisp
+++ b/rt.lisp
@@ -1,3 +1,5 @@
+;-*-syntax:COMMON-LISP;Package:(RT :use "COMMON-LISP" :colon-mode :external)-*-
+
 #|----------------------------------------------------------------------------|
  | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
  |                                                                            |
@@ -27,78 +29,138 @@
 	   #: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")
+(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 *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 *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.")
 
-(defstruct (entry (:conc-name nil)
-		  (:type list))
-  pend name form)
+(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.
 
-(defmacro vals (entry) `(cdddr ,entry))
+(defstruct note
+  name  
+  contents
+  disabled ;; When true, tests with this note are considered inactive
+  )
 
-(defmacro defn (entry) `(cdr ,entry))
+;; (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 ()
-  (do ((l (cdr *entries*) (cdr l))
-       (r nil))
-      ((null l) (nreverse r))
-    (when (pend (car l))
-      (push (name (car l)) r))))
+  (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*))
-  (do ((l *entries* (cdr l)))
-      ((null (cdr l)) nil)
-    (when (equal (name (cadr l)) name)
-      (setf (cdr l) (cddr l))
-      (return name))))
+  (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 (cdr *entries*)
-		     :key #'name
-		     :test #'equal)))
+  (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 form &rest values)
-  `(add-entry '(t ,name ,form .,values)))
+(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-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)
+  (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))
-      (return nil)))
+        (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)))
@@ -108,13 +170,23 @@
 	 (apply #'format t args)
 	 (if error? (throw '*debug* nil)))
 	(error? (apply #'error args))
-	(t (apply #'warn args))))
+	(t (apply #'warn args)))
+  nil)
 
 (defun do-test (&optional (name *test*))
-  (do-entry (get-entry name)))
+  #-sbcl (do-entry (get-entry name))
+  #+sbcl (handler-bind ((sb-ext:code-deletion-note #'muffle-warning))
+		       (do-entry (get-entry name))))
+
+(defun my-aref (a &rest args)
+  (apply #'aref a args))
+
+(defun my-row-major-aref (a index)
+  (row-major-aref a index))
 
 (defun equalp-with-case (x y)
-  "Like EQUALP, but doesn't do case conversion of characters."
+  "Like EQUALP, but doesn't do case conversion of characters.
+   Currently doesn't work on arrays of dimension > 2."
   (cond
    ((eq x y) t)
    ((consp x)
@@ -123,27 +195,30 @@
 	 (equalp-with-case (cdr x) (cdr y))))
    ((and (typep x 'array)
 	 (= (array-rank x) 0))
-    (equalp-with-case (aref x) (aref y)))
+    (equalp-with-case (my-aref x) (my-aref y)))
    ((typep x 'vector)
     (and (typep y 'vector)
 	 (let ((x-len (length x))
 	       (y-len (length y)))
 	   (and (eql x-len y-len)
 		(loop
-		 for e1 across x
-		 for e2 across y
+		 for i from 0 below x-len
+		 for e1 = (my-aref x i)
+		 for e2 = (my-aref y i)
 		 always (equalp-with-case e1 e2))))))
    ((and (typep x 'array)
 	 (typep y 'array)
 	 (not (equal (array-dimensions x)
 		     (array-dimensions y))))
     nil)
+
    ((typep x 'array)
     (and (typep y 'array)
 	 (let ((size (array-total-size x)))
 	   (loop for i from 0 below size
-		 always (equalp-with-case (row-major-aref x i)
-					  (row-major-aref y i))))))
+		 always (equalp-with-case (my-row-major-aref x i)
+					  (my-row-major-aref y i))))))
+
    (t (eql x y))))
 
 (defun do-entry (entry &optional
@@ -161,24 +236,29 @@
 	(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
+			 (funcall (compile
+				   nil
+				   `(lambda ()
+				      (declare
+				       (optimize ,@*optimization-settings*))
+				      ,(form entry))))))
+		       (*expanded-eval*
 			(multiple-value-list
-			 (eval (form entry))))))
+			 (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)
@@ -194,11 +274,53 @@
 		  *test* (form entry)
 		  (length (vals entry))
 		  (vals entry))
-	  (format s "Actual value~P: ~
+	  (handler-case
+	   (let ((st (format nil "Actual value~P: ~
                       ~{~S~^~%~15t~}.~%"
-		  (length r) r)))))
+			    (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*
       (throw '*in-test* nil)
@@ -214,16 +336,19 @@
 	  (stream out :direction :output)
 	(do-entries stream))))
 
-(defun do-entries (s)
+(defun do-entries* (s)
   (format s "~&Doing ~A pending test~:P ~
              of ~A tests total.~%"
-          (count t (cdr *entries*)
-		 :key #'pend)
+          (count t (the list (cdr *entries*)) :key #'pend)
 	  (length (cdr *entries*)))
+  (finish-output s)
   (dolist (entry (cdr *entries*))
-    (when (pend entry)
+    (when (and (pend entry)
+	       (not (has-disabled-note entry)))
       (format s "~@[~<~%~:; ~:@(~S~)~>~]"
-	      (do-entry entry s))))
+	      (do-entry entry s))
+      (finish-output s)
+      ))
   (let ((pending (pending-tests))
 	(expected-table (make-hash-table :test #'equal)))
     (dolist (ex *expected-failures*)
@@ -251,4 +376,34 @@
 		    (length new-failures)
 		    new-failures)))
 	  ))
+      (finish-output s)
       (null pending))))
+
+(defun do-entries (s)
+  #-sbcl (do-entries* s)
+  #+sbcl (handler-bind ((sb-ext:code-deletion-note #'muffle-warning))
+		       (do-entries* s)))
+
+;;; Note handling functions and macros
+
+(defmacro defnote (name contents &optional disabled)
+  `(eval-when (:load-toplevel :execute)
+     (let ((note (make-note :name ',name
+			    :contents ',contents
+			    :disabled ',disabled)))
+       (setf (gethash (note-name note) *notes*) note)
+       note)))
+
+(defun disable-note (n)
+  (let ((note (if (note-p n) n
+		(setf n (gethash n *notes*)))))
+    (unless note (error "~A is not a note or note name." n))
+    (setf (note-disabled note) t)
+    note))
+
+(defun enable-note (n)
+  (let ((note (if (note-p n) n
+		(setf n (gethash n *notes*)))))
+    (unless note (error "~A is not a note or note name." n))
+    (setf (note-disabled note) nil)
+    note))