From 724dc2fdbfe65fbeecf3f5c331d5956b9ab5c50a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 2 Dec 2015 10:00:15 -0700 Subject: [PATCH] fix `namespace-mapped-symbols` forcing of lazy binding info --- .../racket-test-core/tests/racket/module.rktl | 33 +++++++++++++++++++ racket/src/racket/src/syntax.c | 26 +++++++-------- 2 files changed, 46 insertions(+), 13 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/module.rktl b/pkgs/racket-test-core/tests/racket/module.rktl index dab843cf3f..32b05057a8 100644 --- a/pkgs/racket-test-core/tests/racket/module.rktl +++ b/pkgs/racket-test-core/tests/racket/module.rktl @@ -1670,6 +1670,39 @@ case of module-leve bindings; it doesn't cover local bindings. #;(log-error "go") (eval #f)))))) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check `namespace-mapped-symbols` and modidx shifting + +(let () + (define tmp (make-temporary-file "~a-module-test" 'directory)) + (parameterize ([current-directory tmp] + [current-load-relative-directory tmp]) + (make-directory "compiled") + (call-with-output-file* + "compiled/a_rkt.zo" + (lambda (o) (write (compile '(module a racket/base + (provide (all-defined-out)) + (define a 1) + (define b 2) + (define c 3))) + o))) + (call-with-output-file* + "compiled/b_rkt.zo" + (lambda (o) (write (compile '(module b racket/base + (require "a.rkt" + ;; Force saving of context, instead of + ;; reconstruction: + (only-in racket/base [car extra-car])))) + o)))) + (dynamic-require (build-path tmp "b.rkt") #f) + (define ns (module->namespace (build-path tmp "b.rkt"))) + (test #t + 'mapped-symbols + (and (for/and ([name '(a b c)]) + (member name (namespace-mapped-symbols ns))) + #t)) + (delete-directory/files tmp)) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/src/racket/src/syntax.c b/racket/src/racket/src/syntax.c index 51b9711a33..d3c84f460d 100644 --- a/racket/src/racket/src/syntax.c +++ b/racket/src/racket/src/syntax.c @@ -154,7 +154,8 @@ static void register_traversers(void); XFORM_NONGCING static int is_armed(Scheme_Object *v); static Scheme_Object *add_taint_to_stx(Scheme_Object *o, int *mutate); -static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *vec, Scheme_Scope_Set *scopes, Scheme_Object *replace_at); +static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *shifts, + Scheme_Object *vec, Scheme_Scope_Set *scopes, Scheme_Object *replace_at); static Scheme_Object *make_unmarshal_info(Scheme_Object *phase, Scheme_Object *prefix, Scheme_Object *excepts); XFORM_NONGCING static Scheme_Object *extract_unmarshal_phase(Scheme_Object *unmarshal_info); @@ -3491,7 +3492,7 @@ char *scheme_stx_describe_context(Scheme_Object *stx, Scheme_Object *phase, int return ""; } -static void add_scopes_mapped_names(Scheme_Scope_Set *scopes, Scheme_Hash_Table *mapped) +static void add_scopes_mapped_names(Scheme_Scope_Set *scopes, Scheme_Object *shifts, Scheme_Hash_Table *mapped) { int retry; Scheme_Hash_Tree *ht; @@ -3554,7 +3555,7 @@ static void add_scopes_mapped_names(Scheme_Scope_Set *scopes, Scheme_Hash_Table pes = SCHEME_BINDING_VAL(SCHEME_CAR(l)); if (PES_UNMARSHAL_DESCP(pes)) { if (SCHEME_TRUEP(SCHEME_VEC_ELS(pes)[0])) { - unmarshal_module_context_additions(NULL, pes, binding_scopes, l); + unmarshal_module_context_additions(NULL, shifts, pes, binding_scopes, l); retry = 1; } } else { @@ -3651,7 +3652,7 @@ static Scheme_Object *do_stx_lookup(Scheme_Stx *stx, Scheme_Scope_Set *scopes, /* Need unmarshal --- but only if the scope set is relevant */ if (scope_subset(binding_scopes, scopes)) { /* unmarshal and note that we must restart */ - unmarshal_module_context_additions(stx, pes, binding_scopes, l); + unmarshal_module_context_additions(stx, NULL, pes, binding_scopes, l); invalid = 1; /* Shouldn't encounter this on a second pass: */ STX_ASSERT(!check_subset); @@ -4289,7 +4290,9 @@ Scheme_Object *scheme_module_context_inspector(Scheme_Object *mc) void scheme_module_context_add_mapped_symbols(Scheme_Object *mc, Scheme_Hash_Table *mapped) { - add_scopes_mapped_names(scheme_module_context_scopes(mc), mapped); + add_scopes_mapped_names(scheme_module_context_scopes(mc), + SCHEME_VEC_ELS(mc)[3], /* list of shifts */ + mapped); } Scheme_Object *scheme_module_context_at_phase(Scheme_Object *mc, Scheme_Object *phase) @@ -4750,7 +4753,8 @@ static Scheme_Object *unmarshal_key_adjust(Scheme_Object *sym, Scheme_Object *pe return sym; } -static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *vec, Scheme_Scope_Set *scopes, Scheme_Object *replace_at) +static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *shifts, + Scheme_Object *vec, Scheme_Scope_Set *scopes, Scheme_Object *replace_at) { Scheme_Object *req_modidx, *modidx, *unmarshal_info, *context, *src_phase, *pt_phase, *bind_phase; Scheme_Object *insp, *req_insp; @@ -4760,14 +4764,10 @@ static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *v insp = SCHEME_VEC_ELS(vec)[3]; req_insp = insp; - if (stx) { + if (stx) modidx = apply_modidx_shifts(stx->shifts, req_modidx, &insp, &export_registry); - } else { - modidx = req_modidx; - export_registry = NULL; - insp = scheme_false; - req_insp = scheme_false; - } + else + modidx = apply_modidx_shifts(shifts, req_modidx, &insp, &export_registry); src_phase = SCHEME_VEC_ELS(vec)[1]; unmarshal_info = SCHEME_VEC_ELS(vec)[2];