projects
/
ptester.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r5347: *** empty log message ***
[ptester.git]
/
src.lisp
diff --git
a/src.lisp
b/src.lisp
index 3c197bfa347a5132170c90e6d07fb93bf8b11224..e659c90192559145b41b5cb64993e28e99845515 100644
(file)
--- a/
src.lisp
+++ b/
src.lisp
@@
-27,7
+27,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: src.lisp,v 1.
1 2003/07/20 18:10:22
kevin Exp $
+;; $Id: src.lisp,v 1.
2 2003/07/20 18:56:28
kevin Exp $
(defpackage #:ptester
(:use #:cl)
(defpackage #:ptester
(:use #:cl)
@@
-204,6
+204,7
@@
discriminate on new versus known failures."
,@(when wanted-message-given `(:wanted-message ,wanted-message))
,@(when got-message-given `(:got-message ,got-message))))
,@(when wanted-message-given `(:wanted-message ,wanted-message))
,@(when got-message-given `(:got-message ,got-message))))
+(defgeneric conditionp (thing) )
(defmethod conditionp ((thing condition)) t)
(defmethod conditionp ((thing t)) nil)
(defmethod conditionp ((thing condition)) t)
(defmethod conditionp ((thing t)) nil)
@@
-457,22
+458,18
@@
discriminate on new versus known failures."
(if* (eq 'single-got-multiple fail)
then (format
*error-output*
(if* (eq 'single-got-multiple fail)
then (format
*error-output*
- "~
-Reason: additional value were returned from test form.~%")
+ "Reason: additional value were returned from test form.~%")
elseif predicate-failed
then (format *error-output* "Reason: predicate error.~%")
elseif (null (car test-results))
elseif predicate-failed
then (format *error-output* "Reason: predicate error.~%")
elseif (null (car test-results))
- then (format *error-output* "~
-Reason: an error~@[ (of type `~s')~] was detected.~%"
+ then (format *error-output* "Reason: an error~@[ (of type `~s')~] was detected.~%"
(when condition (class-of condition)))
elseif condition
then (if* (not (conditionp condition))
(when condition (class-of condition)))
elseif condition
then (if* (not (conditionp condition))
- then (format *error-output* "~
-Reason: expected but did not detect an error of type `~s'.~%"
+ then (format *error-output* "Reason: expected but did not detect an error of type `~s'.~%"
condition-type)
elseif (null condition-type)
condition-type)
elseif (null condition-type)
- then (format *error-output* "~
-Reason: detected an unexpected error of type `~s':
+ then (format *error-output* "Reason: detected an unexpected error of type `~s':
~a.~%"
(class-of condition)
condition)
~a.~%"
(class-of condition)
condition)
@@
-480,8
+477,7
@@
Reason: detected an unexpected error of type `~s':
then (typep condition condition-type)
else (eq (class-of condition)
(find-class condition-type))))
then (typep condition condition-type)
else (eq (class-of condition)
(find-class condition-type))))
- then (format *error-output* "~
-Reason: detected an incorrect condition type.~%")
+ then (format *error-output* "Reason: detected an incorrect condition type.~%")
(format *error-output*
" wanted: ~s~%" condition-type)
(format *error-output*
(format *error-output*
" wanted: ~s~%" condition-type)
(format *error-output*
@@
-495,8
+491,7
@@
Reason: detected an incorrect condition type.~%")
(simple-condition-format-control
condition)))))
then ;; format control doesn't match
(simple-condition-format-control
condition)))))
then ;; format control doesn't match
- (format *error-output* "~
-Reason: the format-control was incorrect.~%")
+ (format *error-output* "Reason: the format-control was incorrect.~%")
(format *error-output* " wanted: ~s~%" wanted)
(format *error-output* " got: ~s~%" got)
elseif (and format-arguments
(format *error-output* " wanted: ~s~%" wanted)
(format *error-output* " got: ~s~%" got)
elseif (and format-arguments
@@
-505,8
+500,7
@@
Reason: the format-control was incorrect.~%")
(setq wanted
(simple-condition-format-arguments
condition)))))
(setq wanted
(simple-condition-format-arguments
condition)))))
- then (format *error-output* "~
-Reason: the format-arguments were incorrect.~%")
+ then (format *error-output* "Reason: the format-arguments were incorrect.~%")
(format *error-output* " wanted: ~s~%" wanted)
(format *error-output* " got: ~s~%" got)
else ;; what else????
(format *error-output* " wanted: ~s~%" wanted)
(format *error-output* " got: ~s~%" got)
else ;; what else????
@@
-563,8
+557,7
@@
Reason: the format-arguments were incorrect.~%")
(error (c)
(format
*error-output*
(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))))
#+allegro
(let ((state (sys:gsgc-switch :print)))
,g-name c))))
#+allegro
(let ((state (sys:gsgc-switch :print)))