-;; -*- lisp -*-
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
(in-package :it.bese.fiveam)
(predicate value) - Means that we want to ensure that VALUE
satisfies PREDICATE.
- Wrapping the TEST form in a NOT simply preducse a negated reason
+ 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