Improved LIFT's handling and reporting of timeout failures.

They now act like regular failures and respond to break-on-failures-p
and are reported properly in the HTML report.

dev/lift.lisp

@@ -1473,27 +1473,21 @@ Test options are one of :setup, :teardown, :test, :tests, :documentation, :expor
 	(call-next-method))
       (call-next-method)))
 
-(defmethod lift-test :around ((suite test-mixin) name)
-  (if (profile suite)
-      (with-profile-report ((format nil "~a-~a" 
-				    (testsuite-name suite) name) 
-			    (profile suite))
-	(call-next-method))
-      (call-next-method)))
-
-(defmethod do-testing :around ((testsuite process-test-mixin) result fn)
-  (declare (ignore fn))
-  (handler-case
-      (with-timeout ((maximum-time testsuite))
-	(call-next-method))
-    (timeout-error 
-	(c)
-      (declare (ignore c))
-      (let ((suite-name (class-name (class-of testsuite))))
-	(report-test-problem
-	 'test-timeout-failure result suite-name (current-method testsuite)
-	 (make-instance 'test-timeout-condition
-			:maximum-time (maximum-time testsuite)))))))
+(defmethod do-test :around ((suite process-test-mixin) name result)
+  (declare (ignore name))
+  (handler-bind ((timeout-error 
+		  (lambda (c)
+		    (let ((suite-name (class-name (class-of suite))))
+		      (report-test-problem
+		       'test-timeout-failure result suite-name (current-method suite)
+		       (make-instance 'test-timeout-condition
+				      :maximum-time (maximum-time suite))))
+		    (if (find-restart 'test-failed)
+			(invoke-restart 'test-failed c) 
+			(error c)))))
+    (with-timeout ((maximum-time suite))
+      (call-next-method))
+    ))
 
 (defmethod testsuite-log-data ((suite t))
   nil)

dev/test-runner.lisp

@@ -246,7 +246,8 @@ nor configuration file options were specified.")))))
 	 (suite-name (class-name (class-of suite)))
 	 (*current-test-case-name* test-case-name)
 	 (*current-testsuite-name* suite-name)
-	 (error nil))
+	 (error nil)
+	 (current-condition nil))
     (loop for case in (ensure-list
 		       (test-case-option suite-name test-case-name :depends-on))
        unless (test-case-tested-p suite-name case) do
@@ -310,16 +311,24 @@ nor configuration file options were specified.")))))
 	     (report-test-problem
 	      'test-failure result suite-name
 	      *current-test-case-name* condition)
-	     (if (and *test-break-on-failures?*
-		      (not (test-case-expects-failure-p 
-			    suite-name test-case-name)))
-		 (let ((*in-middle-of-failure?* nil))
-		   (invoke-debugger condition))
-		 (go :test-end)))
+	     (setf current-condition condition)
+	     (go :test-failed))
+	   (test-failed (condition) 
+	     :test (lambda (c) (declare (ignore c)) 
+			   *in-middle-of-failure?*)
+	     (setf current-condition condition)
+	     (go :test-failed))
 	   (retry-test () 
 	     :report (lambda (s) (format s "Re-run test-case ~a"
 			     *current-test-case-name*))
 	     (go :test-start)))
+	 :test-failed
+	 (if (and *test-break-on-failures?*
+		  (not (test-case-expects-failure-p 
+			suite-name test-case-name)))
+	     (let ((*in-middle-of-failure?* nil))
+	       (invoke-debugger current-condition))
+	     (go :test-end))
        :test-end)
       (maybe-push-result)))
   (setf *current-test-case-name* test-case-name	*test-result* result)