Documentation
The DWIM checking operator.
If TEST returns a true value a test-passed result is generated,
otherwise a test-failure result is generated and 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 value) - Means that we want to ensure that VALUE
satisfies PREDICATE.
Wrapping the TEST form in a NOT simply preducse a negated reason string.
Source
(defmacro is (test &rest reason-args)
"The DWIM checking operator.
If TEST returns a true value a test-passed result is generated,
otherwise a test-failure result is generated and 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 value) - Means that we want to ensure that VALUE
satisfies PREDICATE.
Wrapping the TEST form in a NOT simply preducse 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)
(list-match-case test
((not (?predicate ?expected ?actual))
(setf bindings (list (list e ?expected)
(list a ?actual))
effective-test `(not (,?predicate ,e ,a))
default-reason-args (list "~S was ~S to ~S" a `',?predicate e)))
((not (?satisfies ?value))
(setf bindings (list (list v ?value))
effective-test `(not (,?satisfies ,v))
default-reason-args (list "~S satisfied ~S" v `',?satisfies)))
((?predicate ?expected ?actual)
(setf bindings (list (list e ?expected)
(list a ?actual))
effective-test `(,?predicate ,e ,a)
default-reason-args (list "~S was not ~S to ~S" a `',?predicate e)))
((?satisfies ?value)
(setf bindings (list (list v ?value))
effective-test `(,?satisfies ,v)
default-reason-args (list "~S did not satisfy ~S" v `',?satisfies)))
(t
(setf bindings '()
effective-test test
default-reason-args "No reason supplied.")))
`(let ,bindings
(if ,effective-test
(add-result 'test-passed :test-expr ',test)
(process-failure :reason ,(if (null reason-args)
`(format nil ,@default-reason-args)
`(format nil ,@reason-args))
:test-expr ',test))))))
Source Context