projects
/
ptester.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r5325: *** empty log message ***
[ptester.git]
/
tester.lisp
diff --git
a/tester.lisp
b/tester.lisp
index 2a15b4b9c00e759bf50094e81149e986b4f927df..0c3222583edcf734de12bd1a0cd675b24878a891 100644
(file)
--- 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
;;;; 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)
(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
(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)))
(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
(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))))
(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))
(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*
(*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~%"
~&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)
#+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)
(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*)
(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)
(provide :tester #+module-versions 1.1)