From 4fb1702144929e5ac7868a895446a985e08344a7 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Thu, 6 Mar 2003 03:59:34 +0000
Subject: [PATCH] Modified some tests so they don't make ecl crash (instead
 they just fail).  Also, modified the RT test harness to work around other
 obnoxious bugs in ecl.

---
 ansi-tests/iteration.lsp | 14 +++++++-----
 ansi-tests/rt.lsp        | 47 +++++++++++++++++++++-------------------
 2 files changed, 33 insertions(+), 28 deletions(-)

diff --git a/ansi-tests/iteration.lsp b/ansi-tests/iteration.lsp
index 5b6d13bc..5de230e7 100644
--- a/ansi-tests/iteration.lsp
+++ b/ansi-tests/iteration.lsp
@@ -391,14 +391,16 @@
   nil)
 
 (deftest dotimes.6
-  (let ((x nil))
-    (dotimes (i -1 x) (push i x)))
-  nil)
+  (block done
+    (dotimes (i -1 'good)
+      (return-from done 'bad)))
+  good)
 
 (deftest dotimes.7
-  (let ((x nil))
-    (dotimes (i (1- most-negative-fixnum) x) (push i x)))
-  nil)
+  (block done
+    (dotimes (i (1- most-negative-fixnum) 'good)
+      (return-from done 'bad)))
+  good)
 
 ;;; Implicit nil block has the right scope
 (deftest dotimes.8
diff --git a/ansi-tests/rt.lsp b/ansi-tests/rt.lsp
index 2e3ce500..b1aa31aa 100644
--- a/ansi-tests/rt.lsp
+++ b/ansi-tests/rt.lsp
@@ -165,31 +165,34 @@ them.")
 	   r)
       ;; (declare (special *break-on-warnings*))
 
-      (flet ((%do
-	      ()
-	      (setf r
-		    (multiple-value-list
-		     (if *compile-tests*
-			 (funcall (compile
-				   nil
-				   `(lambda ()
-				      (declare
-				       (optimize ,@*optimization-settings*))
-				      ,(form entry))))
-		       (eval (form entry)))))))
-	(block aborted
-	  (if *catch-errors*
-	      (handler-bind (#-ecl (style-warning #'muffle-warning)
-				   (error #'(lambda (c)
-					      (setf aborted t)
-					      (setf r (list c))
-					      (return-from aborted nil))))
-			    (%do))
-	    (%do))))
-      
+      (block aborted
+	(setf r
+	      (flet ((%do
+		      ()
+		      (if *compile-tests*
+			  (multiple-value-list
+			   (funcall (compile
+				     nil
+				     `(lambda ()
+					(declare
+					 (optimize ,@*optimization-settings*))
+					,(form entry)))))
+			(multiple-value-list
+			 (eval (form entry))))))
+		(if *catch-errors*
+		    (handler-bind
+		     (#-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 (pend entry)
 	(let ((*print-circle* *print-circle-on-failure*))
 	  (format s "~&Test ~:@(~S~) failed~
-- 
GitLab