X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcheck.lisp;fp=src%2Fcheck.lisp;h=ecf6155004c2cb2873c7b7a322c7d959730b2fb0;hb=98bf60f49ffa34c36fba1ec5eeefb1d96845dfbd;hp=b8ec760d1ddf0ab643930baa5c2e4774fb266597;hpb=bdbb83cf3847669c0e929e4292a25e2d48fa9f81;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))))))