diff --git a/collects/tests/racket/macro.rktl b/collects/tests/racket/macro.rktl index 27fb9effc4..493f57ce86 100644 --- a/collects/tests/racket/macro.rktl +++ b/collects/tests/racket/macro.rktl @@ -803,6 +803,31 @@ (test (list #t #t) map syntax-original? r/ls) (test (list #t #t) map number? (map syntax-position r/ls))) +;; ---------------------------------------- + +(module check-shadower-in-submodule racket/base + (require (for-syntax racket/base)) + + (define-syntax (define-2 stx) + (syntax-case stx () + [(_ id) + (with-syntax ([new-id + ((make-syntax-introducer) + (datum->syntax #f + (string->symbol + (format "~a2" (syntax-e #'id)))))]) + #'(begin + (define new-id 5) + (define-syntax (id stx) + (syntax-local-get-shadower #'new-id))))])) + + (module* main #f + (provide out) + (define-2 f) + (define f2 6) + (define out f))) + +(test 5 dynamic-require '(submod 'check-shadower-in-submodule main) 'out) ;; ---------------------------------------- diff --git a/src/racket/src/env.c b/src/racket/src/env.c index 795975b758..dd4b12a6c5 100644 --- a/src/racket/src/env.c +++ b/src/racket/src/env.c @@ -2278,13 +2278,19 @@ local_get_shadower(int argc, Scheme_Object *argv[]) uid = scheme_find_local_shadower(sym, sym_marks, env); if (!uid) { - /* No lexical shadower, but strip module context, if any */ - sym = scheme_stx_strip_module_context(sym); - /* Add current module context, if any */ - sym = local_module_introduce(1, &sym); + uid = scheme_tl_id_sym(env->genv, sym, NULL, 0, + scheme_make_integer(env->genv->phase), NULL); + if (!SAME_OBJ(uid, SCHEME_STX_VAL(sym))) { + /* has a toplevel biding via marks or context; keep it */ + } else { + /* No lexical shadower, but strip module context, if any */ + sym = scheme_stx_strip_module_context(sym); + /* Add current module context, if any */ + sym = local_module_introduce(1, &sym); - if (!scheme_stx_is_clean(orig_sym)) - sym = scheme_stx_taint(sym); + if (!scheme_stx_is_clean(orig_sym)) + sym = scheme_stx_taint(sym); + } return sym; }