From 9b81acb247816bdda164b53ff26df12c30336b2c Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 20 Dec 2006 00:57:12 +0000
Subject: [PATCH] 359.2, collects changes

svn: r5143

original commit: cf0b303497763314db7f530a6e2d2010ffe44eac
---
 collects/framework/test.ss                    | 10 +++++-----
 collects/mred/private/lock.ss                 | 20 +++++++++----------
 collects/mred/private/repl.ss                 |  5 ++++-
 collects/mred/private/snipfile.ss             |  7 ++++++-
 .../tests/framework/framework-test-engine.ss  | 10 +++++++---
 5 files changed, 32 insertions(+), 20 deletions(-)

diff --git a/collects/framework/test.ss b/collects/framework/test.ss
index b72d3a06..750bc280 100644
--- a/collects/framework/test.ss
+++ b/collects/framework/test.ss
@@ -156,11 +156,11 @@
                       (install-timer (run-interval) return)
                       (unless (is-exn?)
                         (begin-action)
-                        (parameterize ([current-exception-handler
-                                        (λ (exn)
-                                          (end-action-with-error exn)
-                                          ((error-escape-handler)))])
-                          (thunk))
+                        (call-with-exception-handler
+                          (λ (exn)
+                            (end-action-with-error exn)
+                            ((error-escape-handler)))
+                          thunk)
                         (end-action)))]
                    
                    [return (λ () (semaphore-post sem))])
diff --git a/collects/mred/private/lock.ss b/collects/mred/private/lock.ss
index e63d9aff..594563ca 100644
--- a/collects/mred/private/lock.ss
+++ b/collects/mred/private/lock.ss
@@ -50,16 +50,16 @@
 	     (lambda () 
 	       (set! old-paramz (current-parameterization))
 	       (set! old-break-paramz (current-break-parameterization))
-	       (parameterize ([error-value->string-handler entered-err-string-handler]
-			      [current-exception-handler
-			       (lambda (exn)
-				 ;; Get out of atomic region before letting
-				 ;;  an exception handler work
-				 (k (lambda () (raise exn))))])
-		 (parameterize-break #f
-		   (call-with-values 
-		       f 
-		     (lambda args (lambda () (apply values args)))))))
+	       (parameterize ([error-value->string-handler entered-err-string-handler])
+                 (with-handlers ([void (lambda (exn)
+                                         ;; Get out of atomic region before letting
+                                         ;;  an exception handler work
+                                         (k (lambda () (raise exn))))])
+                   (parameterize-break 
+                    #f
+                    (call-with-values 
+                        f 
+                      (lambda args (lambda () (apply values args))))))))
 	     (lambda ()
 	       (set! monitor-owner #f)
 	       (semaphore-post monitor-sema)
diff --git a/collects/mred/private/repl.ss b/collects/mred/private/repl.ss
index a75a1252..96aaea9e 100644
--- a/collects/mred/private/repl.ss
+++ b/collects/mred/private/repl.ss
@@ -120,7 +120,10 @@
 	       void
 	       (lambda () 
 		 (call-with-values
-		     (lambda () (eval (read (open-input-string expr-str))))
+		     (lambda () (call-with-continuation-prompt
+                                 (lambda () (eval (cons
+                                                   '#%top-interaction
+                                                   (read (open-input-string expr-str)))))))
 		   (lambda results
 		     (for-each 
 		      (lambda (v) 
diff --git a/collects/mred/private/snipfile.ss b/collects/mred/private/snipfile.ss
index 76de3348..ca13f084 100644
--- a/collects/mred/private/snipfile.ss
+++ b/collects/mred/private/snipfile.ss
@@ -208,7 +208,12 @@
 		    (let ([exp (read-syntax src in-port)])
 		      (if (eof-object? exp)
 			  (apply values last-time-values)
-			  (call-with-values (lambda () (eval exp))
+			  (call-with-values (lambda () (call-with-continuation-prompt
+                                                        (lambda () (eval 
+                                                                    (datum->syntax-object
+                                                                     #f
+                                                                     (cons '#%top-interaction exp)
+                                                                     exp)))))
 			    (lambda x (loop x)))))))))
 	  (lambda ()
 	    (close-input-port in-port)))))
diff --git a/collects/tests/framework/framework-test-engine.ss b/collects/tests/framework/framework-test-engine.ss
index 371db41e..c09732f0 100644
--- a/collects/tests/framework/framework-test-engine.ss
+++ b/collects/tests/framework/framework-test-engine.ss
@@ -63,13 +63,17 @@
 	[port (current-output-port)])
     (event-dispatch-handler
      (lambda (evt)
-       (parameterize ([current-exception-handler
-		       (let ([oe (current-exception-handler)])
+       (parameterize ([uncaught-exception-handler
+		       (let ([oe (uncaught-exception-handler)])
 			 (lambda (exn)
 			   (protect
 			    (lambda ()
 			      (set! errs (cons exn errs))))
 			   (oe exn)))])
-	 (od evt)))))
+         (call-with-exception-handler
+          (lambda (exn)
+            ((uncaught-exception-handler) exn))
+          (lambda ()
+            (od evt)))))))
 
   (yield (make-semaphore 0)))