From 5456e83ce43c36c540b1956896935a1e8dc51e09 Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Tue, 7 Dec 2010 20:36:26 -0800
Subject: [PATCH] massively faster due to reuse of namespace

---
 collects/tests/stepper/test-engine.rkt   | 26 ++++++++++++++----------
 collects/tests/stepper/through-tests.rkt |  6 +++---
 2 files changed, 18 insertions(+), 14 deletions(-)

diff --git a/collects/tests/stepper/test-engine.rkt b/collects/tests/stepper/test-engine.rkt
index b8720a4655..d17782339f 100644
--- a/collects/tests/stepper/test-engine.rkt
+++ b/collects/tests/stepper/test-engine.rkt
@@ -178,25 +178,29 @@
 
 (define-namespace-anchor n-anchor)
 
+;; it seems to be okay to use the same namespace for all of the tests... 
+(define test-namespace (make-base-namespace))
+(namespace-attach-module (namespace-anchor->empty-namespace n-anchor)
+                         'mzlib/pconvert-prop
+                         test-namespace)
+(parameterize ([current-namespace test-namespace])
+    (namespace-require 'test-engine/racket-tests)
+    ;; make the test engine happy by adding a binding for test~object:
+    (namespace-set-variable-value! 'test~object #f))
+
 ;; call-iter-on-each : (-> syntax?) (syntax? (-> 'a) -> 'a) -> void/c
 ;; call the given iter on each syntax in turn (iter bounces control
 ;; back to us by calling the followup-thunk).
 (define (call-iter-on-each stx-thunk iter)
-  (let ([ns (make-base-namespace)])
-    ;; gets structures to print correctly. Copied from fix in command-line tests.
-    (namespace-attach-module (namespace-anchor->empty-namespace n-anchor)
-                             'mzlib/pconvert-prop
-                             ns)
-  (parameterize ([current-namespace ns])
-    (namespace-require 'test-engine/racket-tests)
-    ;; make the test engine happy by adding a binding for test~object:
-    (namespace-set-variable-value! 'test~object #f)
+  (parameterize ([current-namespace test-namespace])
     (let iter-loop ()
       (let* ([next (stx-thunk)]
-             [followup-thunk (if (eof-object? next) void iter-loop)]
+             [followup-thunk (if (eof-object? next) 
+                                 void
+                                 iter-loop)]
              [expanded (expand next)])
         ;;(printf "~v\n" expanded)
-        (iter expanded followup-thunk))))))
+        (iter expanded followup-thunk)))))
 
 
 (define (warn error-box who fmt . args)
diff --git a/collects/tests/stepper/through-tests.rkt b/collects/tests/stepper/through-tests.rkt
index 643028d9bc..f0860b4c0d 100755
--- a/collects/tests/stepper/through-tests.rkt
+++ b/collects/tests/stepper/through-tests.rkt
@@ -1501,10 +1501,10 @@
      {(define-struct a_1 (b c))} {1})
   
   
- 
+  (provide ggg)
   ;; run whatever tests are enabled (intended for interactive use):
   (define (ggg)
-    (parameterize ([disable-stepper-error-handling #t]
+    (parameterize (#;[disable-stepper-error-handling #t]
                    #;[display-only-errors #t]
                    #;[store-steps #f]
                    #;[show-all-steps #t])
@@ -1512,5 +1512,5 @@
                                   check-error check-error-bad))
       #;(run-tests '(teachpack-universe))
       #;(run-all-tests)
-      (run-tests '(intermediate-lambda-hof))
+      (run-tests '(mz-app2))
       ))