* 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:
parent
24a98cf061
commit
78170587c2
|
@ -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))
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user