From 77e80d4f7d2d8a1aea36f9239abc7e1b25500ecc Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Wed, 6 Aug 2003 14:51:01 +0000
Subject: [PATCH] r5465: *** empty log message ***

---
 assert.lisp |  3 ++-
 tcase.lisp  | 27 ++++++++++++++++++++++-----
 tests.lisp  |  9 ++++++++-
 3 files changed, 32 insertions(+), 7 deletions(-)

diff --git a/assert.lisp b/assert.lisp
index 20d1276..d1d7792 100644
--- a/assert.lisp
+++ b/assert.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:       $Id: assert.lisp,v 1.7 2003/08/06 14:15:32 kevin Exp $
+;;;; ID:       $Id: assert.lisp,v 1.8 2003/08/06 14:51:01 kevin Exp $
 ;;;; Purpose:  Assert functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -49,6 +49,7 @@
      (failure-message ,message "Assert false: ~S" ',v)))
 
 (defmacro assert-condition (condition v &optional message)
+  
   )
 
 (defmacro assert-not-condition (condition v &optional message)
diff --git a/tcase.lisp b/tcase.lisp
index 414eee8..4c13e1e 100644
--- a/tcase.lisp
+++ b/tcase.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: tcase.lisp,v 1.4 2003/08/05 22:56:25 kevin Exp $
+;;;; ID:      $Id: tcase.lisp,v 1.5 2003/08/06 14:51:01 kevin Exp $
 ;;;; Purpose: Test fixtures for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -72,18 +72,35 @@ that the setup method did for this instance."))
   (set-up test)
   (unwind-protect
       (run-test test)
-    (tear-down test)))
+    (tear-down test))
+  (values))
 
 (defmethod run-test ((test test-case))
     (funcall (method-body test)))
 
-(defmethod run-protected ((test test-case) res &key (handle-errors t))
+(defmethod run-protected ((test test-case) res 
+			  &key (handle-errors t) test-condition)
   (if handle-errors
       (handler-case
 	  (run-base test)
 	(assertion-failed (condition)
 	  (add-failure res test condition))
+	(t (condition)
+	  (when (and test-condition
+		     (not (typep condition test-condition)))
+	    (add-failure res test
+			 (make-instance 'assertion-failed
+			   :format-control
+			   "Assert condition ~A, but condition ~A signaled"
+			   :format-arguments
+			   (list test-condition condition)))))
 	(serious-condition (condition)
-	  (add-error res test condition)))
-      (run-base test))
+	  (add-error res test condition))
+	(:no-error ()
+	  (when test-condition
+	    (add-failure res test
+			 (make-instance 'assertion-failed
+			   :format-control "Assert condition ~A, but no condition signaled"
+			   :format-arguments (list test-condition))))))
+    (run-base test))
   res)
diff --git a/tests.lisp b/tests.lisp
index b91520c..60daebf 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Id:      $Id: tests.lisp,v 1.12 2003/08/06 11:37:23 kevin Exp $
+;;;; Id:      $Id: tests.lisp,v 1.13 2003/08/06 14:51:01 kevin Exp $
 ;;;; Purpose: Self Test suite for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -113,7 +113,14 @@
   (assert-equal "2 run, 0 erred, 0 failed" 
 		(summary (run (get-suite test-two-cases)))))
 
+(define-condition test-condition (error)
+  ())
 
+(def-test-method test-condition ((self test-case-test) :run nil)
+  (assert-condition 
+   test-condition 
+   (error (make-instance 'test-condition))))
+		    
 (textui-test-run (get-suite test-case-test))
 
 
-- 
2.34.1