diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index b9bd5e26e1..d4c84f4a0d 100644 --- a/collects/drscheme/private/module-language.ss +++ b/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)) - (raise-hopeless-syntax-error - "invalid language (no #%top-interaction binding)" - lang))) + (check-interactive-language)) (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)) diff --git a/collects/tests/drscheme/module-lang-test-utils.ss b/collects/tests/drscheme/module-lang-test-utils.ss index 9b294ff53a..dd27b32903 100644 --- a/collects/tests/drscheme/module-lang-test-utils.ss +++ b/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) - (sleep 1000 - )))))) + text)))))) (define (run-test) (set-language-level! '("Module") #t) diff --git a/collects/tests/drscheme/module-lang-test.ss b/collects/tests/drscheme/module-lang-test.ss index 56b4fb1caa..9ec6282123 100644 --- a/collects/tests/drscheme/module-lang-test.ss +++ b/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") -(test @t{(module m (file "@in-here{module-lang-test-tmp.ss}") 1 2 3)} + @rx{. compile: bad syntax; reference to top-level identifier is not + 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)