From b055db088c0eaab88598db219bfe4c40cb44fb49 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 2 Jun 2014 21:34:42 +0100 Subject: [PATCH] racket/base: fix `module-compiled-submodules` name handling Mandled name handling breaks pkg binary-mode submodule stripping. --- .../racket-test/tests/racket/submodule.rktl | 12 +++++++++++- racket/src/racket/src/module.c | 18 ++++++++---------- 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/submodule.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/submodule.rktl index 8d3ca71e14..bdfc782746 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/submodule.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/submodule.rktl @@ -138,7 +138,17 @@ (test '(reset i) values (module-compiled-name (car (module-compiled-submodules a #f)))) (define aa (module-compiled-submodules a #f (list (module-compiled-name a 'again)))) (test '(reset again) values (module-compiled-name (car (module-compiled-submodules aa #f)))) - (test '(reset again i) values (module-compiled-name (car (module-compiled-submodules (car (module-compiled-submodules aa #f)) #f))))) + (test '(reset again i) values (module-compiled-name (car (module-compiled-submodules (car (module-compiled-submodules aa #f)) #f)))) + + (define also-c (module-compiled-submodules c #f (module-compiled-submodules c #f))) + (test '(subm-example-0 a) values (module-compiled-name (car (module-compiled-submodules also-c #f)))) + (define re-c + (let ([s (open-output-bytes)]) + (write also-c s) + (parameterize ([read-accept-compiled #t]) + (read (open-input-bytes (get-output-bytes s)))))) + ;; Marshaling flips the order, which is ok: + (test '(subm-example-0 b) values (module-compiled-name (car (module-compiled-submodules re-c #f))))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index 5f401ec93d..c4cd9477ae 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -3418,7 +3418,7 @@ static Scheme_Object *wrap_module_in_top(Scheme_Object *m, Scheme_Object *t) static void reset_submodule_paths(Scheme_Module *m) { Scheme_Module *m2; - Scheme_Object *stack, *l, *l2, *v, *name, *submodule_path; + Scheme_Object *stack, *l, *l2, *v, *v2, *name, *submodule_path; int k; stack = scheme_make_pair((Scheme_Object *)m, scheme_null); @@ -3426,12 +3426,10 @@ static void reset_submodule_paths(Scheme_Module *m) m = (Scheme_Module *)SCHEME_CAR(stack); stack = SCHEME_CDR(stack); - if (!m->submodule_path || SCHEME_NULLP(m->submodule_path)) - submodule_path = scheme_make_pair(scheme_resolved_module_path_value(m->modname), scheme_null); - else { - submodule_path = m->submodule_path; - submodule_path = scheme_reverse(submodule_path); - } + submodule_path = scheme_resolved_module_path_value(m->modname); + if (SCHEME_SYMBOLP(submodule_path)) + submodule_path = scheme_make_pair(submodule_path, scheme_null); + submodule_path = scheme_reverse(submodule_path); for (k = 0; k < 2; k++) { l = (k ? m->post_submodules : m->pre_submodules); @@ -3449,9 +3447,9 @@ static void reset_submodule_paths(Scheme_Module *m) name = SCHEME_CAR(name); } v = scheme_reverse(scheme_make_pair(name, submodule_path)); - m2->submodule_path = v; - v = scheme_intern_resolved_module_path(v); - m2->modname = v; + v2 = scheme_intern_resolved_module_path(v); + m2->modname = v2; + m2->submodule_path = SCHEME_CDR(v); l2 = scheme_make_pair((Scheme_Object *)m2, l2); stack = scheme_make_pair((Scheme_Object *)m2, stack);