Index: rt.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/ansi-tests/rt.lsp,v
retrieving revision 1.29
diff -u -w -p -r1.29 rt.lsp
--- rt.lsp	29 Apr 2006 14:04:36 -0000	1.29
+++ rt.lsp	1 Aug 2008 18:29:20 -0000
@@ -279,18 +279,15 @@
       
       (when (pend entry)
 	(let ((*print-circle* *print-circle-on-failure*))
-	  (format s "~&Test ~:@(~S~) failed~
-                   ~%Form: ~S~
-                   ~%Expected value~P: ~
-                      ~{~S~^~%~17t~}~%"
-		  *test* (form entry)
-		  (length (vals entry))
-		  (vals entry))
+	  (format s "~&Test ~:@(~S~) failed~%Form: ~S~%Expected value~P:~%"
+                  *test* (form entry) (length (vals entry)))
+          (dolist (v (vals entry)) (format s "~10t~S~%" v))
 	  (handler-case
-	   (let ((st (format nil "Actual value~P: ~
-                      ~{~S~^~%~15t~}.~%"
-			     (length r) r)))
-	     (format s "~A" st))
+              (progn
+                (format s "Actual value~P:~%" (length r))
+                (dolist (v r)
+                  (format s "~10t~S~:[~; [~2:*~A]~]~%"
+                          v (typep v 'condition))))
 	   (error () (format s "Actual value: #<error during printing>~%")))
 	  (finish-output s)))))
   (when (not (pend entry)) *test*))
@@ -391,6 +388,20 @@
                          ~^, ~}~)."
 		    (length new-failures)
 		    new-failures)))
+          (when *expected-failures*
+            (let ((pending-table (make-hash-table :test #'equal)))
+              (dolist (ex pending)
+                (setf (gethash ex pending-table) t))
+              (let ((unexpected-successes
+                     (loop :for ex :in *expected-failures*
+                       :unless (gethash ex pending-table) :collect ex)))
+                (if unexpected-successes
+                    (format t "~&~:D unexpected successes: ~
+                   ~:@(~{~<~%   ~1:;~S~>~
+                         ~^, ~}~)."
+                            (length unexpected-successes)
+                            unexpected-successes)
+                    (format t "~&No unexpected successes.")))))
 	  ))
       (finish-output s)
       (null pending))))
