* 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
This commit is contained in:
Eli Barzilay 2008-08-06 21:16:51 +00:00
parent 24a98cf061
commit 78170587c2
3 changed files with 89 additions and 23 deletions

View File

@ -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))

View File

@ -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)

View File

@ -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)