.

original commit: 3a512f0958e28b7ecaa7a0703c5cf77ee317e900

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)

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)

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.")