From: Jim Blandy <jimb@red-bean.com>
Date: Sat, 11 Sep 1999 18:46:32 +0000 (+0000)
Subject: * lib.scm (signals-error?, signals-error?*): New macro and function.
X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/69c74140dde2d7dd543e8df6fc182b9a3e819cfa

* lib.scm (signals-error?, signals-error?*): New macro and function.
* tests/reader.test: Use them.
---

diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index bcf6bd400..4f1f5f710 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -42,7 +42,10 @@
  format-test-name
 
  ;; Finding test input files.
- data-file)
+ data-file
+
+ ;; Noticing whether an error occurs.
+ signals-error? signals-error?*)
 
 
 ;;;; If you're using Emacs's Scheme mode:
@@ -417,3 +420,22 @@
     (or (file-exists? f)
 	(error "Test suite data file does not exist: " f))
     f))
+
+
+;;;; Detecting whether errors occur
+
+;;; (signals-error?* KEY THUNK)
+;;; Apply THUNK, catching errors.  If any errors occur, return #t;
+;;; otherwise, return #f.
+;;;
+;;; KEY indicates the sort of errors to look for; it can be a symbol,
+;;; indicating that only errors with that name should be caught, or
+;;; #t, meaning that any kind of error should be caught.
+(define (signals-error?* key thunk)
+  (catch key
+	 (lambda () (thunk) #f)
+	 (lambda args #t)))
+
+(defmacro signals-error? key-and-body
+  `(signals-error?* ,(car key-and-body)
+		    (lambda () ,@(cdr key-and-body))))
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 773e6b0fc..764cb3680 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -5,12 +5,10 @@
   (pass-if (call-with-output-string (lambda (port)
 				      (display "Try to read " port)
 				      (write string port)))
-	   (catch 'signal
-		  (lambda ()
-		    (call-with-input-string string 
-					    (lambda (p) (read p)))
-		    #t)
-		  (lambda args #f))))
+	   (not (signals-error? 
+		 'signal
+		 (call-with-input-string string 
+					 (lambda (p) (read p)))))))
 
 (try-to-read "0")
 (try-to-read "1++i")