X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcheck.lisp;fp=src%2Fcheck.lisp;h=1bab17deb038052c2008efe524ef2cd9c3bbf901;hb=54f0cf6665c6273328c2c1c98d4f8b4a3508a0ac;hp=ecf6155004c2cb2873c7b7a322c7d959730b2fb0;hpb=3f3b31a89b5019d7a4c020de6eab33e409395b46;p=fiveam.git diff --git a/src/check.lisp b/src/check.lisp index ecf6155..1bab17d 100644 --- a/src/check.lisp +++ b/src/check.lisp @@ -193,27 +193,29 @@ Wrapping the TEST form in a NOT simply preducse a negated reason string." :test-expr ',condition) (add-result 'test-passed :test-expr ',condition))) -(defmacro signals ((condition &optional reason-control reason-args) +(defmacro signals (condition-spec &body body) "Generates a pass if BODY signals a condition of type CONDITION. BODY is evaluated in a block named NIL, CONDITION is not evaluated." (let ((block-name (gensym))) - `(block ,block-name - (handler-bind ((,condition (lambda (c) - (declare (ignore c)) - ;; ok, body threw condition - (add-result 'test-passed - :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)))))) + (destructuring-bind (condition &optional reason-control reason-args) + (ensure-list condition-spec) + `(block ,block-name + (handler-bind ((,condition (lambda (c) + (declare (ignore c)) + ;; ok, body threw condition + (add-result 'test-passed + :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))))))) (defmacro finishes (&body body) "Generates a pass if BODY executes to normal completion. In