diff --git a/pkgs/racket-test-core/tests/racket/macro.rktl b/pkgs/racket-test-core/tests/racket/macro.rktl index 057fd02b60..adb0c90438 100644 --- a/pkgs/racket-test-core/tests/racket/macro.rktl +++ b/pkgs/racket-test-core/tests/racket/macro.rktl @@ -2337,6 +2337,57 @@ (define x 2) (restore)))) +;; ---------------------------------------- +;; Make sure somethign reasonable happens when a `for-syntax` `define` +;; is seen via `local-expand` but is not preserved in the expansion + +(module module-compiles-but-does-not-visit racket/base + (require (for-syntax racket/base)) + + (begin-for-syntax + (when (eq? (syntax-local-context) 'module) + (local-expand + #'(#%plain-module-begin + (begin-for-syntax + (define x 42))) + 'module-begin + '()))) + + (begin-for-syntax + ;; Weird: can be 42 at compile time, but since the for-syntax + ;; `define` did not survive in the fully expanded form, it + ;; turns into a reference to an undefined variable. + x)) + +(err/rt-test (begin + (eval '(require 'module-compiles-but-does-not-visit)) + ;; triggers visit: + (eval #t)) + exn:fail:contract:variable?) + +;; ---------------------------------------- +;; Make sure a reasonable exceptoion happens when `local-expand` +;; is misused under `begin-for-syntax` + +(module module-also-compiles-but-does-not-visit racket/base + (require (for-syntax racket/base)) + + (begin-for-syntax + (local-expand + #'(#%plain-module-begin + (begin-for-syntax + (define x 42))) + 'module-begin + '()))) + +(err/rt-test (begin + (eval '(require 'module-also-compiles-but-does-not-visit)) + ;; triggers visit: + (eval #t)) + (lambda (exn) + (and (exn:fail:syntax? exn) ; the error is from `#%plain-module-begin` + (regexp-match? #rx"not currently transforming a module" (exn-message exn))))) + ;; ---------------------------------------- (report-errs) diff --git a/racket/src/expander/compile/expr.rkt b/racket/src/expander/compile/expr.rkt index ad5dac6285..4803b5639f 100644 --- a/racket/src/expander/compile/expr.rkt +++ b/racket/src/expander/compile/expr.rkt @@ -204,15 +204,20 @@ (error "internal error: cannot assign to a primitive:" (module-binding-sym b))) ;; Expect each primitive to be bound: (module-binding-sym b)] - [(eq? mpi (compile-context-module-self cctx)) - ;; Direct reference to a variable defined in the same module: - (define header (compile-context-header cctx)) - (hash-ref (header-binding-sym-to-define-sym header) - (module-binding-sym b))] + [(and (eq? mpi (compile-context-module-self cctx)) + ;; Direct reference to a variable defined in the same module: + (hash-ref (header-binding-sym-to-define-sym (compile-context-header cctx)) + (module-binding-sym b) + ;; If this `#f` is used as the result, then the identifier must be a + ;; reference to a binding that was introduced through `local-expand`, + ;; but didn't survive to a definition in the full expansion; treat it + ;; as an undefined export. + #f)) + => (lambda (sym) sym)] [else ;; Reference to a variable defined in another module or in an ;; environment (such as the top level) other than a module - ;; context; register as a linklet import + ;; context; register as a linklet import or export (register-required-variable-use! (compile-context-header cctx) (if (inside-module-context? mpi (compile-context-self cctx)) (compile-context-self cctx) diff --git a/racket/src/expander/expand/context.rkt b/racket/src/expander/expand/context.rkt index 7c2e991a3c..aeb26dc86d 100644 --- a/racket/src/expander/expand/context.rkt +++ b/racket/src/expander/expand/context.rkt @@ -215,7 +215,7 @@ ;; Register a callback for `raise-syntax-error` (set-current-previously-unbound! (lambda () - (define ctx (current-expand-context)) + (define ctx (force (current-expand-context))) (define phase-to-ids (and ctx (expand-context-need-eventually-defined ctx))) (and phase-to-ids (hash-ref phase-to-ids (expand-context-phase ctx) null)))) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index 9e09d2d3e9..2bf5fbb2ca 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -17988,7 +17988,7 @@ static const char *startup_source = "(lambda()" "(set-current-previously-unbound!" "(lambda()" -"(let-values(((ctx_0)(current-expand-context)))" +"(let-values(((ctx_0)(force(current-expand-context))))" "(let-values(((phase-to-ids_0)(if ctx_0(expand-context-need-eventually-defined ctx_0) #f)))" "(if phase-to-ids_0(hash-ref phase-to-ids_0(expand-context-phase ctx_0) null) #f))))))" " print-values)" @@ -30943,12 +30943,16 @@ static const char *startup_source = "(module-binding-sym b_0)))" "(void))" "(module-binding-sym b_0)))" +"(let-values(((c1_0)" "(if(eq? mpi_0(compile-context-module-self cctx_0))" -"(let-values()" -"(let-values(((header_0)(compile-context-header cctx_0)))" "(hash-ref" -"(header-binding-sym-to-define-sym header_0)" -"(module-binding-sym b_0))))" +"(header-binding-sym-to-define-sym" +"(compile-context-header cctx_0))" +"(module-binding-sym b_0)" +" #f)" +" #f)))" +"(if c1_0" +"((lambda(sym_0) sym_0) c1_0)" "(let-values()" "(let-values(((temp46_0)(compile-context-header cctx_0))" "((temp47_0)" @@ -30964,7 +30968,8 @@ static const char *startup_source = "(module-binding-extra-inspector b_0)))" "(if or-part_0" " or-part_0" -"(let-values(((or-part_1)(parsed-id-inspector p_0)))" +"(let-values(((or-part_1)" +"(parsed-id-inspector p_0)))" "(if or-part_1" " or-part_1" "(if(parsed-s p_0)" @@ -30976,7 +30981,7 @@ static const char *startup_source = " temp47_0" " temp48_0" " temp49_0" -" temp50_0)))))))" +" temp50_0))))))))" "(let-values()" " (error \"not a reference to a module or local binding:\" b_0 (parsed-s p_0)))))))" "(correlate~(parsed-s p_0)(if set-to?_0(list 'set! sym_0 rhs_0) sym_0)))))))))))))"