syntax-local-lift...: correct error for module-begin context

Relevant to #2052
This commit is contained in:
Matthew Flatt 2018-04-24 08:21:57 -06:00
parent 88d8ba00e0
commit 77d0b0b8f4
3 changed files with 1205 additions and 1169 deletions

View File

@ -981,6 +981,34 @@
(err/rt-test (syntax-local-lift-require 'abc #'def)) (err/rt-test (syntax-local-lift-require 'abc #'def))
(for ([lift-attempt+rx:expected-error
(in-list
(list (cons '(syntax-local-lift-require 'racket #'body)
#rx"could not find target context")
(cons '(syntax-local-lift-expression #'body)
#rx"no lift target")
(cons '(syntax-local-lift-module #'(module m racket/base))
#rx"not currently transforming within a module declaration or top level")
(cons '(syntax-local-lift-module-end-declaration #'(define done #t))
#rx"not currently transforming an expression within a module declaration")
(cons '(syntax-local-lift-provide #'cons)
#rx"not expanding in a module run-time body")))])
(define lift-attempt (car lift-attempt+rx:expected-error))
(define rx:expected-error (cdr lift-attempt+rx:expected-error))
(err/rt-test
(expand `(module m racket/base
(require (for-syntax racket/base))
(provide #%module-begin)
(define-syntax (#%module-begin stx)
(syntax-case stx ()
[(_ body) ,lift-attempt]))
(module* test (submod "..")
body)))
(lambda (exn) (regexp-match? rx:expected-error (exn-message exn)))))
;; ---------------------------------------- ;; ----------------------------------------
(let () (let ()

View File

@ -468,7 +468,11 @@
(struct*-copy expand-context ctx (struct*-copy expand-context ctx
[context 'module-begin] [context 'module-begin]
[module-begin-k module-begin-k] [module-begin-k module-begin-k]
[in-local-expand? #f])) [in-local-expand? #f]
[lifts #f]
[module-lifts #f]
[to-module-lifts #f]
[require-lifts #f]))
(define mb-scopes-s (define mb-scopes-s
(if keep-enclosing-scope-at-phase (if keep-enclosing-scope-at-phase

File diff suppressed because it is too large Load Diff