From fd0d7b12899f8a78146095aa1318f92c49cc0685 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Thu, 21 Nov 2013 22:00:51 -0800
Subject: [PATCH] Make interactive tests faster and support fresh namespaces.

Cuts off about 5-10% of unit test time.
Reuse existing module registry that is shared with all the other tests.
Fresh namespaces means that changes in one test do not affect other
tests.
Only bring in typed/racket/base so that it loads faster.

original commit: 7a1ca9f124fc18024cae03148c6ec4f38c85babe
---
 .../unit-tests/interactive-tests.rkt          | 48 +++++++++++++------
 1 file changed, 34 insertions(+), 14 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt
index 847aca94..81cabaae 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt
@@ -14,45 +14,65 @@
 (provide tests)
 (gen-test-main)
 
-(define promised-ns
+(define-namespace-anchor anchor)
+
+(define base-ns
   (delay
-    (define ns (make-base-namespace))
-    (eval '(require typed/racket) ns)
+    (define ns (namespace-anchor->empty-namespace anchor))
+    (parameterize ([current-namespace ns])
+      (namespace-require 'typed/racket/base))
     ns))
 
+;; get-ns: boolean? -> namespace?
+;; Returns a namespace with the bindings of typed/racket/base.
+;; If the argument is true, then it is a new namespace. This is slower but allows for tests that need
+;; to mutate the namespace to not clash with each other.
+(define (get-ns fresh)
+  (if fresh
+      (let ([ns (variable-reference->empty-namespace
+                  (eval '(#%variable-reference) (force base-ns)))])
+        (parameterize ([current-namespace ns])
+          (namespace-require 'typed/racket/base)
+          ns))
+      (force base-ns)))
+
+(begin-for-syntax
+  (define-splicing-syntax-class fresh-kw
+    (pattern (~seq) #:attr fresh #'#f)
+    (pattern #:fresh #:attr fresh #'#t)))
+
 (define-syntax (test-form-exn stx)
   (syntax-parse stx
-    [(_ regexp:expr form:expr)
+    [(_ f:fresh-kw regexp:expr form:expr)
      (quasisyntax/loc stx
        (test-case #,(~a (syntax->datum #'form))
          (check-exn
            regexp
            (lambda ()
              (eval `(#%top-interaction .
-                     ,(syntax->datum #'form)) (force promised-ns))))))]))
+                     ,(syntax->datum #'form)) (get-ns f.fresh))))))]))
 
 (define-syntax (test-form stx)
   (syntax-parse stx
-    [(_ regexp:expr form:expr)
+    [(_ f:fresh-kw (~seq regexp:expr form:expr) ...)
      (quasisyntax/loc stx
-       (test-case #,(~a (syntax->datum #'form))
+       (test-case #,(~a (syntax->datum #'(form ...)))
+         (define ns (get-ns f.fresh))
          (check-regexp-match
            regexp
            (with-output-to-string
              (lambda ()
                (eval `(#%top-interaction .
-                       ,(syntax->datum #'form)) (force promised-ns)))))))]))
+                       ,(syntax->datum #'form)) ns)))) ...))]))
 
 ;; Add 'only at the toplevel tests'
 (define tests
   (test-suite "Interactive tests"
 
-    (test-form #rx""
-      (module test racket))
-    (test-form #rx""
-      (define module displayln))
-    (test-form #rx"racket"
-      (module 'racket))
+    (test-form #:fresh
+      #rx"" (module test racket)
+      #rx"" (define module displayln)
+      #rx"racket" (module 'racket))
 
     (test-form #rx"1"
       (:type 1))