165 |
r) |
r) |
166 |
;; (declare (special *break-on-warnings*)) |
;; (declare (special *break-on-warnings*)) |
167 |
|
|
168 |
(flet ((%do |
(block aborted |
169 |
() |
(setf r |
170 |
(setf r |
(flet ((%do |
171 |
(multiple-value-list |
() |
172 |
(if *compile-tests* |
(if *compile-tests* |
173 |
(funcall (compile |
(multiple-value-list |
174 |
nil |
(funcall (compile |
175 |
`(lambda () |
nil |
176 |
(declare |
`(lambda () |
177 |
(optimize ,@*optimization-settings*)) |
(declare |
178 |
,(form entry)))) |
(optimize ,@*optimization-settings*)) |
179 |
(eval (form entry))))))) |
,(form entry))))) |
180 |
(block aborted |
(multiple-value-list |
181 |
(if *catch-errors* |
(eval (form entry)))))) |
182 |
(handler-bind (#-ecl (style-warning #'muffle-warning) |
(if *catch-errors* |
183 |
(error #'(lambda (c) |
(handler-bind |
184 |
(setf aborted t) |
(#-ecl (style-warning #'muffle-warning) |
185 |
(setf r (list c)) |
(error #'(lambda (c) |
186 |
(return-from aborted nil)))) |
(setf aborted t) |
187 |
(%do)) |
(setf r (list c)) |
188 |
(%do)))) |
(return-from aborted nil)))) |
189 |
|
(%do)) |
190 |
|
(%do))))) |
191 |
|
|
192 |
(setf (pend entry) |
(setf (pend entry) |
193 |
(or aborted |
(or aborted |
194 |
(not (equalp-with-case r (vals entry))))) |
(not (equalp-with-case r (vals entry))))) |
195 |
|
|
196 |
(when (pend entry) |
(when (pend entry) |
197 |
(let ((*print-circle* *print-circle-on-failure*)) |
(let ((*print-circle* *print-circle-on-failure*)) |
198 |
(format s "~&Test ~:@(~S~) failed~ |
(format s "~&Test ~:@(~S~) failed~ |