XREPL tests.

Not too much, but already tests large parts of sensitive code.  Caught a
bug where ,top would use (enter! #f) but enter grabbed the wrong
namespace since it was instantiated in the wrong namespace.

collects/meta/props

@@ -1979,6 +1979,7 @@ path/s is either such a string or a list of them.
 "collects/tests/xml" responsible (jay)
 "collects/tests/xml/test-clark.rkt" drdr:command-line #f drdr:timeout 300
 "collects/tests/xml/xml-snip-bug.rkt" drdr:command-line (gracket "-t" *)
+"collects/tests/xrepl" responsible (eli)
 "collects/tests/zo-size.rkt" responsible (jay)
 "collects/tex2page" responsible (jay)
 "collects/texpict" responsible (mflatt robby)

collects/tests/xrepl/main.rkt

@@ -0,0 +1,94 @@
+#lang at-exp racket/base
+
+(define verbose? (make-parameter #t))
+
+(define global-ns (current-namespace))
+
+(define stderr (current-error-port))
+
+(define (test-xrepl . args)
+  (define show-all? (verbose?))
+  (define-values [Ii Io] (make-pipe))
+  (define-values [Oi Oo] (make-pipe))
+  (define repl-thread
+    (parameterize ([current-input-port  Ii]
+                   [current-output-port Oo]
+                   [current-error-port  Oo]
+                   [current-namespace (make-empty-namespace)]
+                   [error-print-context-length 0] ; easier output
+                   [exit-handler (λ (_) (kill-thread repl-thread))])
+      (thread (λ ()
+                (namespace-attach-module global-ns 'racket/base)
+                (namespace-require 'racket)
+                (dynamic-require 'xrepl #f)
+                (read-eval-print-loop)))))
+  (define (repl-> expected)
+    (define output (read-string (string-length expected) Oi))
+    (if (equal? output expected)
+      (when show-all? (display output))
+      (error 'xrepl "test failure, expected ~s, got ~s" expected output)))
+  (let loop ([strs args] [input? #f])
+    (cond
+      [(and (pair? strs) (equal? "" (car strs)))
+       (loop (cdr strs) input?)]
+      [(and (thread-dead? repl-thread) (null? strs))
+       (printf "All tests passed.\n")]
+      [(thread-dead? repl-thread)
+       (error 'xrepl "test failure, repl thread died unexpectedly")]
+      [(null? strs)
+       (if (sync/timeout 1 repl-thread)
+         (loop strs input?)
+         (error 'xrepl "test failure, repl thread is alive at end of tests"))]
+      [(eq? '« (car strs))
+       (when input? (error 'xrepl "bad test: unterminated `«'"))
+       (loop (cdr strs) #t)]
+      [(eq? '» (car strs))
+       (unless input? (error 'xrepl "bad test: redundant `»'"))
+       (loop (cdr strs) 'newline)]
+      [(regexp-match #rx"^(.*?)(?: *⇒[^\n]*)(.*)" (car strs))
+       => (λ (m) (loop (list* (cadr m) (caddr m) (cdr strs)) input?))]
+      [(regexp-match #rx"^(.*?)([«»])(.*)" (car strs))
+       => (λ (m) (loop (list* (cadr m) (string->symbol (caddr m)) (cadddr m)
+                              (cdr strs))
+                       input?))]
+      [(eq? 'newline input?)
+       (unless (regexp-match? #rx"^\n" (car strs))
+         (error 'xrepl "bad test: `»' followed by a non-newline"))
+       (newline Io) (flush-output Io)
+       (when show-all? (newline) (flush-output))
+       (loop (cons (substring (car strs) 1) (cdr strs)) #f)]
+      [input?
+       (display (car strs) Io)
+       (when show-all? (display (car strs)) (flush-output))
+       (loop (cdr strs) #t)]
+      [else
+       (repl-> (car strs))
+       (loop (cdr strs) #f)])))
+
+@test-xrepl|={
+  -> «(- 2 1)»
+  1
+  -> «(values 2 3)»
+  2
+  3
+  -> «(values 4)»
+  4
+  -> «(list ^ ^^ ^^^ ^^^^)»
+  '(4 3 2 1)
+  -> «(module foo racket (define x 123))»
+  -> «,en foo»
+  'foo> «x»
+  123
+  'foo> «,top»
+  -> «(define enter! 123)»
+  -> «(enter! 'foo)»
+  procedure application: expected procedure, given: 123; arguments were: 'foo
+  -> «,en foo»                          ⇒ but this still works
+  'foo> «,top»
+  -> «,switch foo»
+  ; *** Initializing a new `foo' namespace with "racket/main.rkt" ***
+  ; *** Switching to the `foo' namespace ***
+  foo::-> «,switch *»
+  ; *** Switching to the `*' namespace ***
+  -> «,ex»
+  |=@||}=|

collects/xrepl/xrepl.rkt

@@ -23,7 +23,8 @@
 (define (autoloaded? sym) (hash-ref autoloaded-specs sym #f))
 (define-syntax-rule (defautoload libspec id ...)
   (begin (define (id . args)
-           (set! id (dynamic-require 'libspec 'id))
+           (set! id (parameterize ([current-namespace hidden-namespace])
+                      (dynamic-require 'libspec 'id)))
            (hash-set! autoloaded-specs 'libspec #t)
            (hash-set! autoloaded-specs 'id #t)
            (apply id args))
@@ -38,13 +39,25 @@
 ;; similar, but just for identifiers
 (define-namespace-anchor anchor)
 (define (here-namespace) (namespace-anchor->namespace anchor))
+(define hidden-namespace (make-base-namespace))
+(define initial-namespace (current-namespace))
+;; when `racket/enter' initializes, it grabs the `current-namespace' to get
+;; back to -- which means it should be instantiated in a top level namespace
+;; rather than in (here-namespace); but if we use `initial-namespace' we
+;; essentially rely on the user to not kill `enter!' (eg, (define enter! 4)).
+;; the solution is to make a `hidden-namespace' where we store these bindings,
+;; then instantiate needed modules in the initial namespace and immediately
+;; attach the modules to the hidden one then use it, so changes to the binding
+;; in `initial-namespace' doesn't affect us.
 (define (make-lazy-identifier sym from)
   (define id #f)
-  (λ () (or id (parameterize ([current-namespace (here-namespace)])
+  (λ () (or id (begin (parameterize ([current-namespace initial-namespace])
-                 (eval (namespace-syntax-introduce
+                        (namespace-require from))
-                        (datum->syntax #f #`(require #,from))))
+                      (parameterize ([current-namespace hidden-namespace])
-                 (set! id (namespace-symbol->identifier sym))
+                        (namespace-attach-module initial-namespace from)
-                 id))))
+                        (namespace-require from)
+                        (set! id (namespace-symbol->identifier sym))
+                        id)))))
 
 ;; makes it easy to use meta-tools without user-namespace contamination
 (define (eval-sexpr-for-user form)
@@ -58,10 +71,9 @@
   (if (path-string? x) (path->relative-string/setup x) x))
 
 (define (here-source) ; returns a path, a symbol, or #f (= not in a module)
-  (let* ([x (datum->syntax #'here '(#%variable-reference))]
+  (variable-reference->module-source
-         [x (eval (namespace-syntax-introduce x))]
+   (eval (namespace-syntax-introduce
-         [x (variable-reference->module-source x)])
+          (datum->syntax #f `(,#'#%variable-reference))))))
-    x))
 
 (define (phase->name phase [fmt #f])
   (define s
@@ -967,7 +979,7 @@
   (λ () (let ([base-stxs #f])
           (unless base-stxs
             (set! base-stxs ; all ids that are bound to a syntax in racket/base
-                  (parameterize ([current-namespace (here-namespace)])
+                  (parameterize ([current-namespace hidden-namespace])
                     (let-values ([(vals stxs) (module->exports 'racket/base)])
                       (map (λ (s) (namespace-symbol->identifier (car s)))
                            (cdr (assq 0 stxs)))))))