X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcheck.lisp;h=ecf6155004c2cb2873c7b7a322c7d959730b2fb0;hb=3f3b31a89b5019d7a4c020de6eab33e409395b46;hp=b8ec760d1ddf0ab643930baa5c2e4774fb266597;hpb=b946ea038243212fde4fa87103604a00666ddbf3;p=fiveam.git

diff --git a/src/check.lisp b/src/check.lisp
index b8ec760..ecf6155 100644
--- a/src/check.lisp
+++ b/src/check.lisp
@@ -193,7 +193,8 @@ 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 &body body)
+(defmacro signals ((condition &optional reason-control reason-args)
+                   &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."
@@ -208,7 +209,9 @@ not evaluated."
 	 (block nil
 	   ,@body
            (process-failure
-            :reason (format nil "Failed to signal a ~S" ',condition)
+            :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))))))