From 258a2c2fca7df7d89e15c8fba399d8d556b8e986 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 30 Apr 2003 15:57:06 +0000
Subject: [PATCH] ..

original commit: 943cfe3708c168cf4b0e2acfcb3a0eebdd5ed12f
---
 collects/tests/framework/mem.ss | 67 +++++++++++++++++++--------------
 1 file changed, 38 insertions(+), 29 deletions(-)

diff --git a/collects/tests/framework/mem.ss b/collects/tests/framework/mem.ss
index 81dcb9bd..59277ed9 100644
--- a/collects/tests/framework/mem.ss
+++ b/collects/tests/framework/mem.ss
@@ -31,34 +31,44 @@
       (yield) (collect-garbage)
       (yield) (collect-garbage)
       (yield) (collect-garbage)
-      (let ([f (make-object dialog% "Results")]
-            [anything? #f])
-        (for-each
-         (lambda (boxl)
-           (let* ([tag (car boxl)]
-                  [boxes (cadr boxl)]
-                  [calc-results
-                   (lambda ()
-		     (let loop ([boxes boxes]
-				[n 0])
-		       (cond
-			 [(null? boxes) n]
-			 [else (if (weak-box-value (car boxes))
-				   (loop (cdr boxes) (+ n 1))
-				   (loop (cdr boxes) n))])))])
-	     (let loop ([tries 16])
-	       (unless (zero? tries)
-		 (when (> (calc-results) 0)
-		   (yield) (yield) (sleep/yield 1/5) (collect-garbage)
-		   (loop (- tries 1)))))
-             (let ([res (calc-results)])
-               (when (> res 0)
-                 (set! anything? #t)
-                 (make-object message% (format "~a: ~a of ~a~n" tag res ,mem-count) f)))))
-         (reverse mem-boxes))
-        (cond
-          [anything? (make-object button% "Close" f (lambda x (send f show #f)))]
-          [else (make-object button% "NOTHING!" f (lambda x (send f show #f)))])
+      (let* ([f (make-object dialog% "Results" #f 300 500)]
+             [text (make-object text%)]
+             [ec (make-object editor-canvas% f text)]
+             [anything? #f])
+        (define (update-gui)
+          (send text erase)
+          (let ([anything? #f])
+            (for-each
+             (lambda (boxl)
+               (let* ([tag (car boxl)]
+                      [boxes (cadr boxl)]
+                      [calc-results
+                       (lambda ()
+                         (let loop ([boxes boxes]
+                                    [n 0])
+                           (cond
+                             [(null? boxes) n]
+                             [else (if (weak-box-value (car boxes))
+                                       (loop (cdr boxes) (+ n 1))
+                                       (loop (cdr boxes) n))])))])
+                 (let ([res (calc-results)])
+                   (when (> res 0)
+                     (set! anything? #t)
+                     (send text insert (format "~a: ~a of ~a\n" tag res ,mem-count))))))
+             (reverse mem-boxes))
+            (unless anything?
+              (send text insert "Nothing!\n"))))
+        
+        (update-gui)
+        (make-object button% "Collect" f (lambda (x y)
+                                           (send text erase)
+                                           (send text insert "Collecting Garbage\n")
+                                           (collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)
+                                           (collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)
+                                           (collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)
+                                           (collect-garbage)(collect-garbage)(collect-garbage)(collect-garbage)
+                                           (update-gui)))
+        (make-object button% "Close" f (lambda (x y) (send f show #f)))
         (send f show #t)))))
 
 (define (test-frame-allocate %)
@@ -110,7 +120,6 @@
 	       '(lambda () (make-object text:return% void))
 	       '(lambda (t) (void)))
 
-
 (test-frame-allocate 'frame:basic%)
 (test-frame-allocate 'frame:info%)
 (test-frame-allocate 'frame:text-info%)