X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcheck.lisp;h=e91b46df8351bee8cfd3679aab6da056fd5673fb;hb=25b02b6e536197f46c8951fed21a452340328bb9;hp=1bab17deb038052c2008efe524ef2cd9c3bbf901;hpb=54f0cf6665c6273328c2c1c98d4f8b4a3508a0ac;p=fiveam.git diff --git a/src/check.lisp b/src/check.lisp index 1bab17d..e91b46d 100644 --- a/src/check.lisp +++ b/src/check.lisp @@ -147,16 +147,14 @@ Wrapping the TEST form in a NOT simply preducse a negated reason string." (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."))) + default-reason-args (list "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)) + (process-failure :reason (format nil ,@(or reason-args default-reason-args)) :test-expr ',test)))))) ;;;; *** Other checks @@ -209,13 +207,13 @@ not evaluated." :test-expr ',condition) (return-from ,block-name t)))) (block nil - ,@body - (process-failure - :reason ,(if reason-control - `(format nil ,reason-control ,@reason-args) - `(format nil "Failed to signal a ~S" ',condition)) - :test-expr ',condition) - (return-from ,block-name nil))))))) + ,@body)) + (process-failure + :reason ,(if reason-control + `(format nil ,reason-control ,@reason-args) + `(format nil "Failed to signal a ~S" ',condition)) + :test-expr ',condition) + (return-from ,block-name nil))))) (defmacro finishes (&body body) "Generates a pass if BODY executes to normal completion. In