diff --git a/ansi-tests/iteration.lsp b/ansi-tests/iteration.lsp index 5b6d13bcbd14e140ed42b5d8d104a92db63baa2a..5de230e75700a881f076bf8555ab361713fa594b 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 2e3ce5007506bbe23ce2c594503fede88ffc8d03..b1aa31aa479d11490a41f3ab0012f5e503238940 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~