-;; -*- lisp -*-
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
(in-package :it.bese.fiveam)
(test-case :accessor test-case :initarg :test-case)
(test-expr :accessor test-expr :initarg :test-expr))
(:documentation "All checking macros will generate an object of
- type TEST-RESULT."))
+type TEST-RESULT."))
(defclass test-passed (test-result)
()
(defun add-result (result-type &rest make-instance-args)
"Create a TEST-RESULT object of type RESULT-TYPE passing it the
- initialize args MAKE-INSTANCE-ARGS and adds the resulting
- object to the list of test results."
+initialize args MAKE-INSTANCE-ARGS and adds the resulting object to
+the list of test results."
(with-run-state (result-list current-test)
(let ((result (apply #'make-instance result-type
(append make-instance-args (list :test-case current-test)))))
otherwise a test-failure result is generated. The reason, unless
REASON-ARGS is provided, is generated based on the form of TEST:
- (predicate expected actual) - Means that we want to check
- whether, according to PREDICATE, the ACTUAL value is
- in fact what we EXPECTED.
+\(predicate expected actual) - Means that we want to check whether,
+according to PREDICATE, the ACTUAL value is in fact what we EXPECTED.
- (predicate value) - Means that we want to ensure that VALUE
- satisfies PREDICATE.
+\(predicate value) - Means that we want to ensure that VALUE satisfies
+PREDICATE.
- Wrapping the TEST form in a NOT simply preducse a negated reason
- string."
+Wrapping the TEST form in a NOT simply produces a negated reason
+string."
(assert (listp test)
(test)
"Argument to IS must be a list, not ~S" test)
(let (bindings effective-test default-reason-args)
- (with-unique-names (e a v)
+ (with-gensyms (e a v)
(flet ((process-entry (predicate expected actual &optional negatedp)
;; make sure EXPECTED is holding the entry that starts with 'values
(when (and (consp actual)
(assert (not (and (consp expected)
(eq (car expected) 'values))) ()
"Both the expected and actual part is a values expression.")
- (let ((tmp expected))
- (setf expected actual
- actual tmp)))
+ (rotatef expected actual))
(let ((setf-forms))
(if (and (consp expected)
(eq (car expected) 'values))
((not (?predicate ?expected ?actual))
(process-entry ?predicate ?expected ?actual t)
(setf default-reason-args
- (list "~S evaluated to ~S, which is ~S to ~S (it should not be)"
+ (list "~2&~S~2% evaluated to ~2&~S~2% which is ~2&~S~2%to ~2&~S~2% (it should not be)"
`',?actual a `',?predicate e)))
((not (?satisfies ?value))
(setf bindings (list (list v ?value))
effective-test `(not (,?satisfies ,v))
default-reason-args
- (list "~S evaluated to ~S, which satisfies ~S (it should not)"
+ (list "~2&~S~2% evaluated to ~2&~S~2% which satisfies ~2&~S~2% (it should not)"
`',?value v `',?satisfies)))
((?predicate ?expected ?actual)
(process-entry ?predicate ?expected ?actual)
(setf default-reason-args
- (list "~S evaluated to ~S, which is not ~S to ~S."
+ (list "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%."
`',?actual a `',?predicate e)))
((?satisfies ?value)
(setf bindings (list (list v ?value))
effective-test `(,?satisfies ,v)
default-reason-args
- (list "~S evaluated to ~S, which does not satisfy ~S"
+ (list "~2&~S~2% evaluated to ~2&~S~2% which does not satisfy ~2&~S~2%"
`',?value v `',?satisfies)))
(?_
(setf bindings '()
effective-test test
- default-reason-args (list "~S was NIL." `',test)))))
+ default-reason-args (list "~2&~S~2% was NIL." `',test)))))
`(let ,bindings
(if ,effective-test
(add-result 'test-passed :test-expr ',test)
failure otherwise. Like IS-TRUE, and unlike IS, IS-FALSE does
not inspect CONDITION to determine what reason to give it case
of test failure"
-
- (with-unique-names (value)
+
+ (with-gensyms (value)
`(let ((,value ,condition))
(if ,value
(process-failure