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

another `namespace-attach-module' repair for submodules

Browse Source 
Merge to v5.3
This commit is contained in:
Matthew Flatt 2012-07-19 16:49:54 -05:00
parent 99dbc321f5
commit a45d13b52a
2 changed files with 54 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/tests/racket/submodule.rktl
View File

@ -675,34 +675,41 @@
;; Module attach
(let ()
(define (test-attach decl-only? pre-check?)
(let ([ns1 (make-base-namespace)]
[ns2 (make-base-namespace)]
[ns3 (make-base-namespace)])
(parameterize ([current-namespace ns1])
(eval '(module m racket/base
(provide root) (define root 'm)
(module+ n (provide x) (define x 'x))))
(unless decl-only?
(dynamic-require ''m #f)
(when pre-check?
(test 'x dynamic-require '(submod 'm n) 'x))))
(parameterize ([current-namespace ns2])
((if decl-only? namespace-attach-module-declaration namespace-attach-module)
ns1
''m)
(test 'x dynamic-require '(submod 'm n) 'x))
(unless decl-only?
(define (attach-tests use-path?)
(define (test-attach decl-only? pre-check?)
(define path (and use-path?
(build-path (find-system-path 'temp-dir) "mod.rkt")))
(let ([ns1 (make-base-namespace)]
[ns2 (make-base-namespace)]
[ns3 (make-base-namespace)])
(parameterize ([current-namespace ns1])
(test 'x dynamic-require '(submod 'm n) 'x)))
(parameterize ([current-namespace ns3])
((if decl-only? namespace-attach-module-declaration namespace-attach-module)
ns1
'(submod 'm n))
(test 'm dynamic-require ''m 'root))))
(test-attach #f #f)
(test-attach #f #t)
(test-attach #t #f))
(parameterize ([current-module-declare-name (and use-path?
(make-resolved-module-path path))])
(eval '(module m racket/base
(provide root) (define root 'm)
(module+ n (provide x) (define x 'x)))))
(unless decl-only?
(dynamic-require (or path ''m) #f)
(when pre-check?
(test 'x dynamic-require `(submod ,(or path ''m) n) 'x))))
(parameterize ([current-namespace ns2])
((if decl-only? namespace-attach-module-declaration namespace-attach-module)
ns1
(or path ''m))
(test 'x dynamic-require `(submod ,(or path ''m) n) 'x))
(unless decl-only?
(parameterize ([current-namespace ns1])
(test 'x dynamic-require `(submod ,(or path ''m) n) 'x)))
(parameterize ([current-namespace ns3])
((if decl-only? namespace-attach-module-declaration namespace-attach-module)
ns1
`(submod ,(or path ''m) n))
(test 'm dynamic-require (or path ''m) 'root))))
(test-attach #f #f)
(test-attach #f #t)
(test-attach #t #f))
(attach-tests #f)
(attach-tests #t))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

35
src/racket/src/module.c
View File

@ -1453,8 +1453,10 @@ void ensure_instantiate_for_label(const char *who, Scheme_Env *from_env, Scheme_
}
}
static Scheme_Object *make_sub_modidx(Scheme_Env *menv, Scheme_Object *name, int i)
static Scheme_Object *make_sub_modidx_pair(Scheme_Env *menv, Scheme_Object *name, int i)
{
Scheme_Object *modidx;
if (i) {
name = scheme_resolved_module_path_value(name);
while (SCHEME_PAIRP(SCHEME_CDR(name))) {
@ -1465,12 +1467,15 @@ static Scheme_Object *make_sub_modidx(Scheme_Env *menv, Scheme_Object *name, int
name = scheme_make_utf8_string("..");
}
return scheme_make_modidx(scheme_make_pair(submod_symbol,
scheme_make_pair(scheme_make_utf8_string("."),
scheme_make_pair(name,
scheme_null))),
menv->link_midx,
scheme_false);
modidx = scheme_make_modidx(scheme_make_pair(submod_symbol,
scheme_make_pair(scheme_make_utf8_string("."),
scheme_make_pair(name,
scheme_null))),
menv->link_midx,
scheme_false);
name = scheme_module_resolve(modidx, 0);
return scheme_make_pair(name, modidx);
}
#if 0
@ -1785,10 +1790,10 @@ static Scheme_Object *do_namespace_attach_module(const char *who, int argc, Sche
name = ((Scheme_Module *)SCHEME_CAR(l))->modname;
if (!scheme_hash_get(nophase_checked, name)) {
LOG_ATTACH(printf("Add s %s\n", scheme_write_to_string(name, NULL)));
nophase_todo = scheme_make_pair(scheme_make_pair(name, make_sub_modidx(menv, name, i)),
nophase_todo);
scheme_hash_set(nophase_checked, name, just_declare ? scheme_false : scheme_true);
name = make_sub_modidx_pair(menv, name, i);
LOG_ATTACH(printf("Add s %s\n", scheme_write_to_string(SCHEME_CAR(name), NULL)));
nophase_todo = scheme_make_pair(name, nophase_todo);
scheme_hash_set(nophase_checked, SCHEME_CAR(name), just_declare ? scheme_false : scheme_true);
}
l = SCHEME_CDR(l);
}
@ -1970,10 +1975,10 @@ static Scheme_Object *do_namespace_attach_module(const char *who, int argc, Sche
name = ((Scheme_Module *)SCHEME_CAR(l))->modname;
if (!scheme_hash_get(nophase_checked, name)) {
LOG_ATTACH(printf("Add s %s\n", scheme_write_to_string(name, NULL)));
nophase_todo = scheme_make_pair(scheme_make_pair(name, make_sub_modidx(menv, name, i)),
nophase_todo);
scheme_hash_set(nophase_checked, name, just_declare ? scheme_false : scheme_true);
name = make_sub_modidx_pair(menv, name, i);
LOG_ATTACH(printf("Add s %s\n", scheme_write_to_string(SCHEME_CAR(name), NULL)));
nophase_todo = scheme_make_pair(name, nophase_todo);
scheme_hash_set(nophase_checked, SCHEME_CAR(name), just_declare ? scheme_false : scheme_true);
}
l = SCHEME_CDR(l);
}