suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix namespace-mapped-symbols forcing of lazy binding info

Browse Source
This commit is contained in:
Matthew Flatt 2015-12-02 10:00:15 -07:00
parent a6eb00a41c
commit 724dc2fdbf
2 changed files with 46 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
pkgs/racket-test-core/tests/racket/module.rktl
View File

@ -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)

26
racket/src/racket/src/syntax.c
View File

@ -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];