;;;; 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)
,@(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)
(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))
- 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))
- 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)
- 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)
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*
(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
(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????
(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)))