From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Thu, 12 Jul 2012 22:01:21 +0000 (-0700)
Subject: Added warn-errors?, like ignore-errors, to turn errors into warnings.
X-Git-Tag: release-9.2.0~237
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e17cb3459d48d491e9f8d93bc32841a54a12f1c6;p=mit-scheme.git

Added warn-errors?, like ignore-errors, to turn errors into warnings.
---

diff --git a/src/runtime/error.scm b/src/runtime/error.scm
index e01ace41d..502a5f123 100644
--- a/src/runtime/error.scm
+++ b/src/runtime/error.scm
@@ -1230,6 +1230,14 @@ USA.
 					   'IGNORE-ERRORS)))
        thunk))))
 
+(define warn-errors?
+  (let ((ok "ok"))
+    (lambda (thunk)
+      (let ((v (ignore-errors (lambda () (thunk) ok))))
+	(cond ((eq? v ok) #f)
+	      ((condition? v) (warn v) #t)
+	      (else (error "Unexpected value:" v)))))))
+
 (define (format-error-message message irritants port)
   (fluid-let ((*unparser-list-depth-limit* 2)
 	      (*unparser-list-breadth-limit* 5))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 23ee71521..2e64aa00a 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1817,6 +1817,7 @@ USA.
 	  format-error-message
 	  hook/invoke-condition-handler
 	  ignore-errors
+	  warn-errors?
 	  invoke-restart
 	  invoke-restart-interactively
 	  make-condition