47 |
(defvar *expanded-eval* nil "When true, convert the tests into a form that is less likely to have compiler optimizations.") |
(defvar *expanded-eval* nil "When true, convert the tests into a form that is less likely to have compiler optimizations.") |
48 |
(defvar *optimization-settings* '((safety 3))) |
(defvar *optimization-settings* '((safety 3))) |
49 |
|
|
50 |
|
(defvar *failed-tests* nil "After DO-TESTS, becomes the list of names of tests that have failed") |
51 |
|
(defvar *passed-tests* nil "After DO-TESTS, becomes the list of names of tests that have passed") |
52 |
|
|
53 |
(defvar *expected-failures* nil |
(defvar *expected-failures* nil |
54 |
"A list of test names that are expected to fail.") |
"A list of test names that are expected to fail.") |
55 |
|
|
273 |
(handler-case |
(handler-case |
274 |
(let ((st (format nil "Actual value~P: ~ |
(let ((st (format nil "Actual value~P: ~ |
275 |
~{~S~^~%~15t~}.~%" |
~{~S~^~%~15t~}.~%" |
276 |
(length r) r))) |
(length r) r))) |
277 |
(format s "~A" st)) |
(format s "~A" st)) |
278 |
(error () (format s "Actual value: #<error during printing>~%") |
(error () (format s "Actual value: #<error during printing>~%") |
279 |
)) |
)) |
280 |
(finish-output s) |
(finish-output s))))) |
|
)))) |
|
281 |
(when (not (pend entry)) *test*)) |
(when (not (pend entry)) *test*)) |
282 |
|
|
283 |
(defun expanded-eval (form) |
(defun expanded-eval (form) |
323 |
|
|
324 |
(defun do-tests (&optional |
(defun do-tests (&optional |
325 |
(out *standard-output*)) |
(out *standard-output*)) |
326 |
|
(setq *failed-tests* nil |
327 |
|
*passed-tests* nil) |
328 |
(dolist (entry (cdr *entries*)) |
(dolist (entry (cdr *entries*)) |
329 |
(setf (pend entry) t)) |
(setf (pend entry) t)) |
330 |
(if (streamp out) |
(if (streamp out) |
342 |
(dolist (entry (cdr *entries*)) |
(dolist (entry (cdr *entries*)) |
343 |
(when (and (pend entry) |
(when (and (pend entry) |
344 |
(not (has-disabled-note entry))) |
(not (has-disabled-note entry))) |
345 |
(format s "~@[~<~%~:; ~:@(~S~)~>~]" |
(let ((success? (do-entry entry s))) |
346 |
(do-entry entry s)) |
(if success? |
347 |
|
(push (name entry) *passed-tests*) |
348 |
|
(push (name entry) *failed-tests*)) |
349 |
|
(format s "~@[~<~%~:; ~:@(~S~)~>~]" success?)) |
350 |
(finish-output s) |
(finish-output s) |
351 |
)) |
)) |
352 |
(let ((pending (pending-tests)) |
(let ((pending (pending-tests)) |