From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Wed, 1 Feb 2017 07:30:11 +0000 (-0700)
Subject: tests/unit-testing.scm: Add expectation to assert-error failure.
X-Git-Tag: mit-scheme-pucked-9.2.12~235^2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=19b63e879d854a35c8a4355ee716ce1c55d326de;p=mit-scheme.git

tests/unit-testing.scm: Add expectation to assert-error failure.

Recently bytevector-u8-ref did not signal a range error but returned a
random value.  The failure report only said "value <random>".  Now it
also includes the expected condition type(s).
---

diff --git a/tests/unit-testing.scm b/tests/unit-testing.scm
index 0b965e86a..c894abcc6 100644
--- a/tests/unit-testing.scm
+++ b/tests/unit-testing.scm
@@ -397,19 +397,21 @@ USA.
   (predicate-assertion null? "an empty list"))
 
 (define-for-tests (assert-error thunk #!optional condition-types . properties)
-  (call-with-current-continuation
-   (lambda (k)
-     (apply fail
-	    'RESULT-OBJECT
-	    (bind-condition-handler
-		(if (default-object? condition-types)
-		    (list condition-type:error)
-		    condition-types)
-		(lambda (condition)
-		  condition		;ignore
-		  (k #f))
-	      thunk)
-	    properties))))
+  (let ((condition-types (if (default-object? condition-types)
+			     (list condition-type:error)
+			     condition-types)))
+    (call-with-current-continuation
+     (lambda (k)
+       (apply fail
+	      'RESULT-OBJECT
+	      (bind-condition-handler
+		  condition-types
+		  (lambda (condition)
+		    condition		;ignore
+		    (k #f))
+		thunk)
+	      'EXPECTATION-OBJECT condition-types
+	      properties)))))
 
 (define-for-tests (error-assertion . condition-types)
   (lambda (thunk . properties)