diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl index bd71517863..df04da458a 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl @@ -1108,7 +1108,7 @@ (eval '(m))))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Check a a submodule can be armed: +;; Check that a submodule can be armed: (test #t syntax? @@ -1118,6 +1118,47 @@ (define-syntax-rule (s) (module x racket/base 10)) (s))))) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check interaction of marks and a syntax-object side channel + +;; Tests a special case that makes a reference to an identifier in +;; the enclosing module work, even though the identifier is missing +;; a module context. + +(let () + (define (mk mode wrap?) + `(module m racket + (require (for-syntax syntax/parse racket/syntax)) + (define-for-syntax funny #f) + (define-syntax (make-funny-set! stx) + (syntax-parse stx + [(_ v) + (define unmarked (generate-temporary)) + (set! funny (syntax-local-introduce unmarked)) + #`(define #,unmarked v)])) + (define-syntax (funny-ref stx) + (syntax-parse stx + [(_) + funny])) + (define-syntax (funny-set! stx) + (syntax-parse stx + [(_ v) + #`(set! #,funny v)])) + (define-syntax (funny-varref stx) + (syntax-parse stx + [(_) + #`(#%variable-reference #,funny)])) + (make-funny-set! 2) + ,((if wrap? (lambda (v) `(let () ,v)) values) + (case mode + [(ref) '(funny-ref)] + [(set) '(funny-set! 3)] + [(var) '(funny-varref)])))) + (for* ([m '(ref set var)] + [wrap? '(#t #f)]) + (parameterize ([current-namespace (make-base-namespace)]) + (eval (mk m wrap?))))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/src/racket/src/compenv.c b/racket/src/racket/src/compenv.c index 45001b83b4..ab3f1dc933 100644 --- a/racket/src/racket/src/compenv.c +++ b/racket/src/racket/src/compenv.c @@ -1909,22 +1909,32 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, modname = NULL; if (genv->module && genv->disallow_unbound) { - if (genv->disallow_unbound > 0) { - /* Free identifier. Maybe don't continue. */ - if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) { - scheme_unbound_syntax(((flags & SCHEME_SETTING) - ? scheme_set_stx_string - : scheme_var_ref_string), - NULL, src_find_id, "unbound identifier in module"); - return NULL; - } - if (flags & SCHEME_NULL_FOR_UNBOUND) - return NULL; + /* double-check for a local-module binding that's not in find_id's context; + see a similar test in scheme_check_top_identifier_bound() */ + find_global_id = scheme_tl_id_sym(genv, find_id, NULL, 0, NULL, NULL); + if (!SAME_OBJ(find_global_id, SCHEME_STX_SYM(find_id))) { + /* it's defined after all; fall through below assumes a binding + in the enclosing module */ } else { - if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) { - scheme_register_unbound_toplevel(env, src_find_id); + /* If find_global_id is not find_id, then the module must have a + definition of the identifier. */ + if (genv->disallow_unbound > 0) { + /* Free identifier. Maybe don't continue. */ + if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) { + scheme_unbound_syntax(((flags & SCHEME_SETTING) + ? scheme_set_stx_string + : scheme_var_ref_string), + NULL, src_find_id, "unbound identifier in module"); + return NULL; + } + if (flags & SCHEME_NULL_FOR_UNBOUND) + return NULL; + } else { + if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) { + scheme_register_unbound_toplevel(env, src_find_id); + } + /* continue, for now */ } - /* continue, for now */ } } } diff --git a/racket/src/racket/src/compile.c b/racket/src/racket/src/compile.c index d025d8ec68..98757e18e7 100644 --- a/racket/src/racket/src/compile.c +++ b/racket/src/racket/src/compile.c @@ -5222,7 +5222,10 @@ int scheme_check_top_identifier_bound(Scheme_Object *c, Scheme_Env *genv, int di tl_id = scheme_tl_id_sym(genv, symbol, NULL, 0, NULL, NULL); if (NOT_SAME_OBJ(tl_id, SCHEME_STX_SYM(symbol))) { - /* Since the module has a rename for this id, it's certainly defined. */ + /* Since the module has a rename for this id, count it as + defined. This covers the unusual case that a marked identifier + is bound in a module, but the identifier doesn't have the + module's post_ex_rename_set in its lexical information. */ bad = 0; } else { modidx = scheme_stx_module_name(NULL, &symbol, scheme_make_integer(genv->phase), NULL, NULL, NULL,