X-Git-Url: http://git.kpe.io/?p=ptester.git;a=blobdiff_plain;f=tester.lisp;h=0c3222583edcf734de12bd1a0cd675b24878a891;hp=2a15b4b9c00e759bf50094e81149e986b4f927df;hb=8677e99488829df6eda4ba0b6f1a8cb487e5abd8;hpb=7c63f04f4833c6ab447dc7f409e119d8e08c2b0c diff --git a/tester.lisp b/tester.lisp index 2a15b4b..0c32225 100644 --- a/tester.lisp +++ b/tester.lisp @@ -26,7 +26,7 @@ ;;;; from the original ACL 6.1 sources: ;; Id: tester.cl,v 2.2.12.1 2001/06/05 18:45:10 layer Exp -;; $Id: tester.lisp,v 1.2 2003/02/23 06:10:02 kevin Exp $ +;; $Id: tester.lisp,v 1.3 2003/07/18 19:47:07 kevin Exp $ (defpackage :util.test (:use :common-lisp) @@ -392,12 +392,14 @@ discriminate on new versus known failures." (defvar *announce-test* nil) ;; if true announce each test that was done -(defmacro errorset (form) - `(handler-case (cons t (multiple-value-list ,form)) +(defmacro errorset (form) ;subset of test-values-errorset + `(handler-case + (values-list (cons t (multiple-value-list ,form))) (error (cond) (format *error-output* "~&An error occurred: ~a~%" cond) nil))) + (defun test-check (&key (predicate #'eql) expected-result test-results test-form multiple-values fail-info known-failure @@ -415,10 +417,11 @@ discriminate on new versus known failures." (multiple-value-list (errorset (funcall predicate expected-result result)))) (failed (null (car results)))) - (if* failed - then (setq predicate-failed t) - nil - else (cadr results))))) + (if failed + (progn + (setq predicate-failed t) + nil) + (cadr results))))) (when (conditionp test-results) (setq condition test-results) (setq test-results nil)) @@ -554,14 +557,14 @@ Reason: the format-arguments were incorrect.~%") (*test-unexpected-failures* 0)) (format *error-output* "Begin ~a test~%" ,g-name) (if* *break-on-test-failures* - then (doit) - else (handler-case (doit) - (error (c) - (format - *error-output* - "~ + then (doit) + else (handler-case (doit) + (error (c) + (format + *error-output* + "~ ~&Test ~a aborted by signalling an uncaught error:~%~a~%" - ,g-name c)))) + ,g-name c)))) #+allegro (let ((state (sys:gsgc-switch :print))) (setf (sys:gsgc-switch :print) nil) @@ -576,9 +579,9 @@ Reason: the format-arguments were incorrect.~%") (progn (format t "~&**********************************~%" ,g-name) (format t "End ~a test~%" ,g-name) - (format t "Errors detected in this test: ~s " *test-errors*) + (format t "Errors detected in this test: ~D " *test-errors*) (unless (zerop *test-unexpected-failures*) - (format t "UNEXPECTED: ~s" *test-unexpected-failures*)) - (format t "~%Successes this test:~s~%" *test-successes*)))))) + (format t "UNEXPECTED: ~D" *test-unexpected-failures*)) + (format t "~%Successes this test:~D~%" *test-successes*)))))) (provide :tester #+module-versions 1.1)