From af82a8ad610e637e4b8912146e08dc72ecb0286f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 9 Dec 1999 01:19:43 +0000
Subject: [PATCH] .

original commit: 42b6f993c01e462569690c5b3dc08b51c5ba6414
---
 collects/tests/mred/frame-steps.txt |  6 ++----
 collects/tests/mred/mem.ss          | 16 +++++++++-------
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/collects/tests/mred/frame-steps.txt b/collects/tests/mred/frame-steps.txt
index 50e3d11a..ec3051fd 100644
--- a/collects/tests/mred/frame-steps.txt
+++ b/collects/tests/mred/frame-steps.txt
@@ -50,9 +50,7 @@ Medium Frame should contain:
  V Slider (a vertical slider)
  H Gauge (a horizontal slider)
  V Gauge (a vertical slider)
- Howdy (a canvas-message)
- <BB logo> (a canvas-message)
- Text (a media-text)
+ Text (a multi-line text field)
    initial & starting
 
 The names on labels must match the above exactly (except that <>
@@ -64,7 +62,7 @@ Make sure all the controls with moving parts work.
 Tabbing and arrow keys should work correctly. The canvas in the bottom
 middle area does not receive the focus via tabs in Big Frame, but it
 does in Medium Frame. When it receives the focus via a tab, "Tab in"
-is drawn inthe canvas; when the focus leaves the canvas for any reason
+is drawn in the canvas; when the focus leaves the canvas for any reason
 (tab out, mouse click somewhere else, etc.), "Tab in" is erased.
 
 Window Resizing
diff --git a/collects/tests/mred/mem.ss b/collects/tests/mred/mem.ss
index c8f35517..10a43808 100644
--- a/collects/tests/mred/mem.ss
+++ b/collects/tests/mred/mem.ss
@@ -3,8 +3,8 @@
 
 (define source-dir (current-load-relative-directory))
 
-(define num-times 4)
-(define num-threads 1)
+(define num-times 8)
+(define num-threads 3)
 
 (define dump-stats? #f)
 
@@ -34,6 +34,7 @@
    'sub-collect-panel
    (make-object panel% sub-collect-frame)))
 
+(define permanent-ready? #f)
 (define mb-lock (make-semaphore 1))
 
 (define htw (make-hash-table-weak))
@@ -179,17 +180,18 @@
 	      (send i delete)))
 
 	  (when subwindows?
-	    (unless (send sub-collect-frame get-menu-bar)
+	    (unless permanent-ready?
 	      (semaphore-wait mb-lock)
 	      (unless (send sub-collect-frame get-menu-bar)
 		(let ([mb (make-object menu-bar% sub-collect-frame)])
 		  (make-object menu% "Permanent" mb)))
+	      (set! permanent-ready? #t)
 	      (semaphore-post mb-lock))
 	    (let* ([mb (send sub-collect-frame get-menu-bar)]
 		   [mm (car (send mb get-items))])
-	      (send (remember tag (make-object menu-item% "Delete Me" mm void)) delete)
-	      (let ([m (make-object menu% "Temporary" mb)])
-		(remember tag (make-object menu-item% "Temp Hi" m void))
+	      (send (remember (cons 'm tag) (make-object menu-item% "Delete Me" mm void)) delete)
+	      (let ([m (remember tag (make-object menu% "Temporary" mb))])
+		(remember (cons 't tag) (make-object menu-item% "Temp Hi" m void))
 		(send m delete)))))
 	  	  
 	(when atomic?
@@ -260,7 +262,7 @@
       (unless (zero? n)
 	(yield sema)
 	(loop (sub1 n)))))
-  
+
   (collect-garbage)
   (collect-garbage)
   (let loop ([n 100])