From ad5e0e4195cab32cfbba912adae104e390f4387d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 30 Aug 1999 23:44:47 +0000
Subject: [PATCH] .

original commit: bdf5291eb92dca83329a357db68f712a80993af7
---
 collects/tests/mred/draw.ss      |  9 +++++++--
 collects/tests/mred/windowing.ss | 15 +++++++++++++++
 2 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/collects/tests/mred/draw.ss b/collects/tests/mred/draw.ss
index df80704a..6def0ff0 100644
--- a/collects/tests/mred/draw.ss
+++ b/collects/tests/mred/draw.ss
@@ -575,7 +575,9 @@
 		  (send (get-dc) set-origin 0 0)
 
 		  (let ([dc (if ps?
-				(let ([dc (make-object post-script-dc%)])
+				(let ([dc (if (eq? ps? 'print)
+					      (make-object printer-dc%)
+					      (make-object post-script-dc%))])
 				  (and (send dc ok?) dc))
 				(if (and use-bitmap?)
 				    (begin
@@ -701,9 +703,12 @@
 		   (set! use-bad? (< 2 (send self get-selection)))
 		   (send canvas on-paint))
 		 '(horizontal))
-    (make-object button% "PostScript" hp
+    (make-object button% "PS" hp
 		 (lambda (self event)
 		   (send canvas on-paint #t)))
+    (make-object button% "Print" hp
+		 (lambda (self event)
+		   (send canvas on-paint 'print)))
     (make-object check-box% "*2" hp
 		 (lambda (self event)
 		   (send canvas set-scale (if (send self get-value) 2 1))))
diff --git a/collects/tests/mred/windowing.ss b/collects/tests/mred/windowing.ss
index 22e1b3b3..66232001 100644
--- a/collects/tests/mred/windowing.ss
+++ b/collects/tests/mred/windowing.ss
@@ -2,6 +2,21 @@
 (when (not (defined? 'test))
   (load-relative "testing.ss"))
 
+; These message boxes mustn't survive
+(let ([c (make-custodian)])
+  (parameterize ([current-custodian c])
+    (parameterize ([current-eventspace (make-eventspace)])
+      (queue-callback
+       (lambda ()
+	 (queue-callback
+	  (lambda ()
+	    (sleep/yield 0.1)
+	    (queue-callback
+	     (lambda ()
+	       (custodian-shutdown-all c)))
+	    (message-box "w" "q")))
+	 (message-box "x" "y"))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                           Windowing Tests                                  ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;