From 766c1f147d0dcab42871f96bd6c81fed3aa5e8c4 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 6 Jan 1999 15:13:30 +0000
Subject: [PATCH] .

original commit: 3a512f0958e28b7ecaa7a0703c5cf77ee317e900
---
 collects/tests/mred/editor.ss |  2 +-
 collects/tests/mred/paramz.ss | 45 +++++++++++++++++++++++++++++++++++
 src/mred/wrap/mred.ss         | 12 ++++++----
 3 files changed, 53 insertions(+), 6 deletions(-)
 create mode 100644 collects/tests/mred/paramz.ss

diff --git a/collects/tests/mred/editor.ss b/collects/tests/mred/editor.ss
index 0bdacfe5..a1794d08 100644
--- a/collects/tests/mred/editor.ss
+++ b/collects/tests/mred/editor.ss
@@ -9,6 +9,7 @@
 ;;;;;; Undo tests
 
 (define e (make-object text%))
+
 (stv e insert "Hello")
 (st #t e is-modified?)
 (stv e undo)
@@ -62,5 +63,4 @@
 (test #t 'undone? undone?)
 (st "Hello" e get-text)
 
-
 (report-errs)
diff --git a/collects/tests/mred/paramz.ss b/collects/tests/mred/paramz.ss
new file mode 100644
index 00000000..5f238709
--- /dev/null
+++ b/collects/tests/mred/paramz.ss
@@ -0,0 +1,45 @@
+
+(when (not (defined? 'test))
+  (load-relative "testing.ss"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                        Parameterization Tests                              ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (get-hello thunk)
+  (parameterize ([debug-info-handler (lambda () 'hello)])
+    (with-handlers ([void (lambda (x) (exn-debug-info x))])
+      (thunk))))
+
+(test 'hello
+      'debug-info-handler
+      (get-hello (lambda () (make-object frame% #f))))
+
+(test 'hello
+      'debug-info-handler
+      (get-hello (lambda () (let ([f (make-object frame% #f)])
+			      (send f set-status-text 'bad-val)))))
+
+;; Killing an eventspace
+(define c (make-custodian))
+(define e (parameterize ([current-custodian c]) (make-eventspace)))
+(parameterize ([current-eventspace e]) (send (make-object frame% "x" #f 50 50) show #t))
+(custodian-shutdown-all c)
+(define (try-use-es t)
+  (test
+   'error
+   'shutdown-eventspace
+   (with-handlers ([(lambda (x)
+		      (and (exn:misc? x)
+			   (regexp-match "shut down" (exn-message x))))
+		    (lambda (x)
+		      (printf "got expected error: ~a~n" (exn-message x))
+		      'error)])
+     (parameterize ([current-eventspace e]) 
+       (t)))))
+(try-use-es (lambda () (make-object frame% "x" #f 50 50)))
+(try-use-es (lambda () (make-object dialog% "x" #f 50 50)))
+(try-use-es (lambda () (make-object timer%)))
+(try-use-es (lambda () (queue-callback void)))
+
+(report-errs)
diff --git a/src/mred/wrap/mred.ss b/src/mred/wrap/mred.ss
index f4c97926..f155e1d3 100644
--- a/src/mred/wrap/mred.ss
+++ b/src/mred/wrap/mred.ss
@@ -68,7 +68,7 @@
     ((let/ec k
        (dynamic-wind
 	(lambda () 
-	  (semaphore-wait monitor-sema)
+	  (wx:in-atomic-region monitor-sema)
 	  
 	  (set! monitor-owner (current-thread))
 	  (setup-entered-paramz)
@@ -83,7 +83,8 @@
 	  (set! monitor-owner #f)
 	  (current-parameterization old-paramz)
 	  
-	  (semaphore-post monitor-sema)))))]))
+	  (semaphore-post monitor-sema)
+	  (wx:in-atomic-region #f)))))]))
 
 ; entry-point macros in macros.ss
 
@@ -96,10 +97,11 @@
        (set! monitor-owner #f)
        (current-parameterization old-paramz)
        
-       (semaphore-post monitor-sema))
+       (semaphore-post monitor-sema)
+       (wx:in-atomic-region #f))
      f
      (lambda ()
-       (semaphore-wait monitor-sema)
+       (wx:in-atomic-region monitor-sema)
 
        (set! monitor-owner (current-thread))
        (setup-entered-paramz)
@@ -3965,7 +3967,7 @@
 	  (let ([e (last-position)])
 	    (insert #\newline)
 	    (change-style (send (make-object wx:style-delta% 'change-bold) set-delta-foreground "BLUE") s e)))
-	(output (format "Copyright (c) 1995-98 PLT (Matthew Flatt and Robby Findler)~n"))
+	(output (format "Copyright (c) 1995-99 PLT (Matthew Flatt and Robby Findler)~n"))
 	(insert "This is a simple window for evaluating MrEd Scheme expressions.") (insert #\newline)
 	(let ([s (last-position)])
 	  (insert "Quit now and run DrScheme to get a better window.")