fixup! Break into the debugger upon error

Rework evaluation-strategy

src/testcase.lisp

@@ -320,48 +320,58 @@ instead of returning normally."))
 (defun instrument-assertion-1 (&key name form type argument-names argument-lambdas assertion-lambda)
   "Supervise the execution of ARGUMENTS-LAMBDA and ASSERTION-LAMBDA."
   (labels ((evaluation-strategy-1 (argument-condition argument-values)
-	     (when argument-condition
-	       (signal
-		'assertion-condition
-		:path *testcase-path*
-		:name name
-		:argument-names argument-names
-		:argument-values argument-values
-		:form form
-		:type type
-		:condition (first argument-condition))
-	       (return-from evaluation-strategy-1))
-	     (multiple-value-bind (success-p description)
-		 (handler-case (funcall assertion-lambda argument-values)
-	     	   (serious-condition (unexpected-condition)
-		     (signal
-		      'assertion-condition
-		      :path *testcase-path*
-		      :name name
-		      :argument-names argument-names
-		      :argument-values argument-values
-		      :form form
-		      :type type
-		      :condition unexpected-condition)
-		     (return-from evaluation-strategy-1)))
-	       (cond
-		 ((not success-p)
-		  (signal 'assertion-failure
-			  :path *testcase-path*
-			  :name name
-			  :argument-names argument-names
-			  :argument-values argument-values
-			  :form form
-			  :type type
-			  :description description))
-		 (t
-		  (signal 'assertion-success
-			  :path *testcase-path*
-			  :name name
-			  :argument-names argument-names
-			  :argument-values argument-values
-			  :form form
-			  :type type)))))
+	     (flet ((signal-argument-condition (condition)
+		      (signal
+		       'assertion-condition
+		       :path *testcase-path*
+		       :name name
+		       :argument-names argument-names
+		       :argument-values argument-values
+		       :form form
+		       :type type
+		       :condition condition))
+		    (signal-unexpected-condition (condition)
+		      (signal
+		       'assertion-condition
+		       :path *testcase-path*
+		       :name name
+		       :argument-names argument-names
+		       :argument-values argument-values
+		       :form form
+		       :type type
+		       :condition condition))
+		    (signal-failure (description)
+		      (signal
+		       'assertion-failure
+		       :path *testcase-path*
+		       :name name
+		       :argument-names argument-names
+		       :argument-values argument-values
+		       :form form
+		       :type type
+		       :description description))
+		    (signal-success ()
+		      (signal
+		       'assertion-success
+		       :path *testcase-path*
+		       :name name
+		       :argument-names argument-names
+		       :argument-values argument-values
+		       :form form
+		       :type type)))
+	       (when argument-condition
+		 (signal-argument-condition (first argument-condition))
+		 (return-from evaluation-strategy-1))
+	       (multiple-value-bind (success-p description)
+		   (handler-case (funcall assertion-lambda argument-values)
+	     	     (serious-condition (unexpected-condition)
+		       (signal-unexpected-condition unexpected-condition)
+		       (return-from evaluation-strategy-1)))
+		 (cond
+		   ((not success-p)
+		    (signal-failure description))
+		   (t
+		    (signal-success))))))
 	   (evaluation-strategy (argument-values)
 	     (evaluation-strategy-1
 	      (member-if (lambda (object) (typep object 'condition)) argument-values)