Skip to content
Snippets Groups Projects
Commit 4fb17021 authored by pfdietz's avatar pfdietz
Browse files

Modified some tests so they don't make ecl crash (instead they just fail). ...

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.
parent cd1aca75
No related branches found
No related tags found
No related merge requests found
...@@ -391,14 +391,16 @@ ...@@ -391,14 +391,16 @@
nil) nil)
(deftest dotimes.6 (deftest dotimes.6
(let ((x nil)) (block done
(dotimes (i -1 x) (push i x))) (dotimes (i -1 'good)
nil) (return-from done 'bad)))
good)
(deftest dotimes.7 (deftest dotimes.7
(let ((x nil)) (block done
(dotimes (i (1- most-negative-fixnum) x) (push i x))) (dotimes (i (1- most-negative-fixnum) 'good)
nil) (return-from done 'bad)))
good)
;;; Implicit nil block has the right scope ;;; Implicit nil block has the right scope
(deftest dotimes.8 (deftest dotimes.8
......
...@@ -165,31 +165,34 @@ them.") ...@@ -165,31 +165,34 @@ them.")
r) r)
;; (declare (special *break-on-warnings*)) ;; (declare (special *break-on-warnings*))
(flet ((%do (block aborted
() (setf r
(setf r (flet ((%do
(multiple-value-list ()
(if *compile-tests* (if *compile-tests*
(funcall (compile (multiple-value-list
nil (funcall (compile
`(lambda () nil
(declare `(lambda ()
(optimize ,@*optimization-settings*)) (declare
,(form entry)))) (optimize ,@*optimization-settings*))
(eval (form entry))))))) ,(form entry)))))
(block aborted (multiple-value-list
(if *catch-errors* (eval (form entry))))))
(handler-bind (#-ecl (style-warning #'muffle-warning) (if *catch-errors*
(error #'(lambda (c) (handler-bind
(setf aborted t) (#-ecl (style-warning #'muffle-warning)
(setf r (list c)) (error #'(lambda (c)
(return-from aborted nil)))) (setf aborted t)
(%do)) (setf r (list c))
(%do)))) (return-from aborted nil))))
(%do))
(%do)))))
(setf (pend entry) (setf (pend entry)
(or aborted (or aborted
(not (equalp-with-case r (vals entry))))) (not (equalp-with-case r (vals entry)))))
(when (pend entry) (when (pend entry)
(let ((*print-circle* *print-circle-on-failure*)) (let ((*print-circle* *print-circle-on-failure*))
(format s "~&Test ~:@(~S~) failed~ (format s "~&Test ~:@(~S~) failed~
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment