* Fixed a minor bug in the module language

* More test improvement, remove test-debugging `sleep'
* Add tests for new module language behavior with misc errors

svn: r11115

collects/drscheme/private/module-language.ss

@@ -172,6 +172,11 @@
                  more)))
             (transform-module path expr)))
         (define modspec (or path `',(syntax-e name)))
+        (define (check-interactive-language)
+          (unless (memq '#%top-interaction (namespace-mapped-symbols))
+            (raise-hopeless-syntax-error
+             "invalid language (no #%top-interaction binding)"
+             lang)))
         ;; We're about to send the module expression to drscheme now, the rest
         ;; of the setup is done in `front-end/finished-complete-program' below,
         ;; so use `repl-init-thunk' to store an appropriate continuation for
@@ -194,15 +199,13 @@
                                   (raise-hopeless-exception
                                    e "invalid language specification"))])
             (namespace-require lang))
-          (unless (memq '#%top-interaction (namespace-mapped-symbols))
+          (check-interactive-language))
-            (raise-hopeless-syntax-error
-             "invalid language (no #%top-interaction binding)"
-             lang)))
         (define (*init)
           ;; the prompt makes it continue after an error
           (call-with-continuation-prompt
            (λ () (dynamic-require modspec #f)))
-          (current-namespace (module->namespace modspec)))
+          (current-namespace (module->namespace modspec))
+          (check-interactive-language))
         ;; here's where they're all combined with the module expression
         (expr-getter *pre module-expr *post))
       

collects/tests/drscheme/module-lang-test-utils.ss

@@ -1,10 +1,12 @@
 #lang scheme/gui
 (require "drscheme-test-util.ss" mzlib/etc framework scheme/string)
 
-(provide test t run-test in-here write-test-modules)
+(provide test t rx run-test in-here write-test-modules)
 
-;; utility to use with scribble/reader
+;; utilities to use with scribble/reader
 (define t string-append)
+(define (rx . strs)
+  (regexp (regexp-replace* #rx" *\n *" (string-append* strs) ".*")))
 
 (define-struct test (definitions  ; string
                      interactions ; (union #f string)
@@ -50,7 +52,7 @@
                      get-text
                      (send interactions-text paragraph-start-position 2)
                      (send interactions-text paragraph-end-position 2))])
-          (unless (string=? "> " after-execute-output)
+          (unless (or (test-all? test) (string=? "> " after-execute-output))
             (printf "FAILED: ~a\n        ~a\n        expected no output after execution, got: ~s\n"
                     (test-definitions test)
                     (or (test-interactions test) 'no-interactions)
@@ -80,9 +82,7 @@
                   (test-definitions test)
                   (or (test-interactions test) 'no-interactions)
                   (test-result test)
-                  text)
+                  text))))))
-          (sleep 1000
-                 ))))))
 
 (define (run-test)
   (set-language-level! '("Module") #t)

collects/tests/drscheme/module-lang-test.ss

@@ -5,7 +5,7 @@
 
 ;; set up for tests that need external files
 (write-test-modules
- (module module-lang-test-tmp mzscheme
+ (module module-lang-test-tmp1 mzscheme
    (provide (all-from-except mzscheme +)
             x)
    (define x 1))
@@ -18,24 +18,44 @@
        [(dat . thing)
         (number? (syntax-e (syntax thing)))
         (syntax/loc stx (#%datum . thing))]))
-   (provide #%module-begin [rename bug-datum #%datum])))
+   (provide #%module-begin [rename bug-datum #%datum]))
+ (module module-lang-test-tmp4 scheme/base
+   (/ 888 2)
+   (provide (except-out (all-from-out scheme/base) #%top-interaction))))
 
 (test @t{}
       #f
-      #rx"Module Language: There must be a valid module .* Try starting"
+      @rx{Module Language: There must be a valid module
+          Try starting your program with
+          Interactions disabled}
       #t)
 (test @t{1}
       #f
-      #rx"Module Language: only a module expression is allowed"
+      @rx{Module Language: only a module expression is allowed
+          Interactions disabled}
       #t)
 (test @t{(module m mzscheme) 1}
       #f
-      #rx"Module Language: there can only be one expression in the definitions"
+      @rx{Module Language: there can only be one expression in the definitions
+          Interactions disabled}
+      #t)
+(test @t{.}
+      #f
+      @rx{Module Language: invalid module text
+          read: illegal
+          Interactions disabled}
       #t)
 (test @t{#lang mzscheme
          (define x 1)}
       @t{x}
       "1")
+(test @t{#lang m-z-scheme
+         (define x 1)}
+      #f
+      @rx{Module Language: invalid module text
+          collection not found
+          Interactions disabled}
+      #t)
 (test @t{(module m mzscheme (provide x) (define x 1))}
       @t{x}
       "1")
@@ -62,10 +82,10 @@
       ". . reference to an identifier before its definition: foldl")
 (test @t{(module m mzscheme (require (prefix mz: mzscheme)))}
       @t{mz:+}
-      #rx"procedure:+")
+      #rx"procedure:[+]")
 (test @t{(module n mzscheme (provide (all-from-except mzscheme +)))}
       @t{+}
-      #rx"procedure:+")
+      #rx"procedure:[+]")
 (test @t{(module m mzscheme
            (require (prefix x: (lib "list.ss")) (lib "list.ss")))}
       @t{foldl}
@@ -74,11 +94,11 @@
            (require (prefix x: (lib "list.ss")) (lib "list.ss")))}
       @t{x:foldl}
       #rx"foldl>")
-(test @t{(module m (file "@in-here{module-lang-test-tmp.ss}") x)}
+(test @t{(module m (file "@in-here{module-lang-test-tmp1.ss}") x)}
       @t{x}
       "1")
 ;; + shouldn't be bound in the REPL because it isn't bound in the module.
-(test @t{(module m (file "@in-here{module-lang-test-tmp.ss}") x)}
+(test @t{(module m (file "@in-here{module-lang-test-tmp1.ss}") x)}
       @t{+}
       ". . reference to an identifier before its definition: +")
 (test @t{(module m mzscheme (provide lambda))}
@@ -118,7 +138,9 @@
            (provide s)
            (define-syntax (s stx) e))}
       @t{(require m) s}
-      #rx"module-lang-test-tmp2.ss:1:[67][90]: compile: bad syntax; literal data is not allowed, because no #%datum syntax transformer is bound in: 1$")
+      @rx{module-lang-test-tmp2.ss:1:[67][90]: compile: bad syntax;
+          literal data is not allowed, because no #%datum syntax transformer
+          is bound in: 1$})
 (test @t{(module tmp mzscheme
            (provide (rename app #%app)
                     (rename -current-namespace current-namespace)
@@ -132,7 +154,48 @@
 (test @t{#lang scheme
          (eval 'cons)}
       #f
-      ". compile: bad syntax; reference to top-level identifier is not allowed, because no #%top syntax transformer is bound in: cons")
+      @rx{. compile: bad syntax; reference to top-level identifier is not
-(test @t{(module m (file "@in-here{module-lang-test-tmp.ss}") 1 2 3)}
+          allowed, because no #%top syntax transformer is bound in: cons})
+(test @t{(module m (file "@in-here{module-lang-test-tmp1.ss}") 1 2 3)}
       @t{1} ;; just make sure no errors.
       "1")
+;; check that we have a working repl in the right language after
+;; syntax errors, unless it's a bad language
+(test @t{#lang scheme
+         (define x 1)
+         (define y (/ 0))}
+      @t{(+ 122 x)}
+      @rx{. /: division by zero
+          123}
+      #t)
+(test @t{#lang scheme
+         (define x 1)
+         (define y (/ 0))}
+      @t{(if x 123)}
+      @rx{. /: division by zero
+          . if: bad syntax.*"else"}
+      #t)
+(test @t{#lang mzscheme
+         (define x 1)
+         (define y (/ 0))}
+      @t{(if x 123)}
+      @rx{. /: division by zero
+          123}
+      #t)
+(test @t{(module xx scheme/list ;"xx.ss" ;scheme/list
+           (define x 1)
+           (define y (/ 0)))}
+      #f
+      @rx{no #%module-begin binding in the module's language
+          Module Language: invalid language \(no #%top-interaction binding\)
+          Interactions disabled}
+      #t)
+(test @t{(module xx (file "@in-here{module-lang-test-tmp4.ss}")
+           (define x 1)
+           (* x 123))}
+      #f
+      @rx{444
+          123
+          Module Language: invalid language \(no #%top-interaction binding\)
+          Interactions disabled}
+      #t)