From 076684b123093b30fbe0f75e94df95e6b8adf34b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 8 Oct 2018 15:05:39 -0600 Subject: [PATCH] bytecode compiler: fix mishandling of export names The repair in 4396b841c0 for internal names exposed a problem with the way `linklet` handled renaming on export, where it mixed up the names that should be used internally and externally in errors. Merge to v7.1 --- .../racket-test-core/tests/racket/syntax.rktl | 12 +++++ racket/src/racket/src/compile.c | 45 ++++++++++++------- 2 files changed, 42 insertions(+), 15 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/syntax.rktl b/pkgs/racket-test-core/tests/racket/syntax.rktl index 280d18104c..e94f7025c0 100644 --- a/pkgs/racket-test-core/tests/racket/syntax.rktl +++ b/pkgs/racket-test-core/tests/racket/syntax.rktl @@ -2150,6 +2150,18 @@ (test #t regexp-match? #rx"^foo:" (exn-message v)) (test 5 eval (exn:fail:contract:variable-id v) (module->namespace ''tries-to-use-foo-before-defined))) +;; A top-level `cons` is renamed internally to something like `1/cons` +;; to avoid shadowing a primitive, but the variable name is still +;; `cons` and an exception should contain 'cons +(let ([e (with-handlers ([exn:fail:contract:variable? values]) + (define ns (make-base-empty-namespace)) + (namespace-require `(all-except racket/base cons) ns) + (eval 'cons ns))]) + (test #t exn? e) + (test #t exn:fail:contract:variable? e) + (test 'cons exn:fail:contract:variable-id e) + (test #t regexp-match? #rx"^cons: " (exn-message e))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/src/racket/src/compile.c b/racket/src/racket/src/compile.c index 9b873ef295..e963fa7918 100644 --- a/racket/src/racket/src/compile.c +++ b/racket/src/racket/src/compile.c @@ -82,7 +82,7 @@ static Scheme_Object *generate_defn_name(Scheme_Object *base_sym, Scheme_Hash_Tree *also_used_names, int search_start); -static Scheme_Object *extract_source_name(Scheme_Object *e); +static Scheme_Object *extract_source_name(Scheme_Object *e, int no_default); #ifdef MZ_PRECISE_GC static void register_traversers(void); @@ -1964,7 +1964,7 @@ static Scheme_Object *define_parse(Scheme_Object *form, name = SCHEME_STX_CAR(vars); scheme_check_identifier(NULL, name, NULL, form); - src_name = extract_source_name(name); + src_name = extract_source_name(name, 0); if (!SAME_OBJ(src_name, SCHEME_STX_SYM(name))) source_names = scheme_hash_tree_set(source_names, SCHEME_STX_SYM(name), src_name); @@ -2015,13 +2015,17 @@ static void check_import_export_clause(Scheme_Object *e, Scheme_Object *orig_for scheme_wrong_syntax(NULL, e, orig_form, "bad import/export clause"); } -static Scheme_Object *extract_source_name(Scheme_Object *e) +static Scheme_Object *extract_source_name(Scheme_Object *e, int no_default) { Scheme_Object *a; a = scheme_stx_property(e, source_name_symbol, NULL); - if (!a || !SCHEME_SYMBOLP(a)) - a = SCHEME_STX_SYM(e); + if (!a || !SCHEME_SYMBOLP(a)) { + if (no_default) + a = NULL; + else + a = SCHEME_STX_SYM(e); + } return a; } @@ -2107,24 +2111,35 @@ Scheme_Linklet *scheme_compile_linklet(Scheme_Object *form, int set_undef, Schem defn_syms = scheme_make_vector(len, NULL); source_names = scheme_make_hash_tree(0); also_used_names = scheme_make_hash_tree(0); - + for (j = 0; j < len; j++, exports = SCHEME_STX_CDR(exports)) { e = SCHEME_STX_CAR(exports); check_import_export_clause(e, orig_form); if (SCHEME_STX_SYMBOLP(e)) { - SCHEME_VEC_ELS(defn_syms)[j] = SCHEME_STX_SYM(e); + a = SCHEME_STX_SYM(e); } else { - SCHEME_VEC_ELS(defn_syms)[j] = SCHEME_STX_SYM(SCHEME_STX_CADR(e)); + a = SCHEME_STX_SYM(SCHEME_STX_CADR(e)); e = SCHEME_STX_CAR(e); } - a = extract_source_name(e); + /* The export name is used as the variable name. Note that the + export name at the `linklet` level will correspond to the + definition name at the `module` level. */ + SCHEME_VEC_ELS(defn_syms)[j] = a; if (scheme_hash_tree_get(source_names, a) || scheme_hash_tree_get(also_used_names, a)) { scheme_wrong_syntax("linklet", a, NULL, "duplicate export"); } - if (!SAME_OBJ(a, SCHEME_VEC_ELS(defn_syms)[j])) - source_names = scheme_hash_tree_set(source_names, SCHEME_VEC_ELS(defn_syms)[j], a); - else - also_used_names = scheme_hash_tree_set(also_used_names, a, scheme_true); + /* Alternative source name supplied? */ + a = extract_source_name(e, 1); + if (a) { + if (!SAME_OBJ(a, SCHEME_VEC_ELS(defn_syms)[j])) + source_names = scheme_hash_tree_set(source_names, SCHEME_VEC_ELS(defn_syms)[j], a); + else + also_used_names = scheme_hash_tree_set(also_used_names, SCHEME_VEC_ELS(defn_syms)[j], scheme_true); + } else { + /* Otherwise, use the export name (not the defined name) as the public name; + it matches the variable name */ + also_used_names = scheme_hash_tree_set(also_used_names, SCHEME_VEC_ELS(defn_syms)[j], scheme_true); + } tl = scheme_make_ir_toplevel(-1, j, 0); env = scheme_extend_comp_env(env, e, (Scheme_Object *)tl, 1, 1); if (!env) @@ -2135,7 +2150,7 @@ Scheme_Linklet *scheme_compile_linklet(Scheme_Object *form, int set_undef, Schem not exported */ extra_vars_pos = len; all_extra_vars = scheme_null; - + for (i = 0, a = form; i < body_len; i++, a = SCHEME_STX_CDR(a)) { e = SCHEME_STX_CAR(a); if (is_define_values(e)) { @@ -2164,7 +2179,7 @@ Scheme_Linklet *scheme_compile_linklet(Scheme_Object *form, int set_undef, Schem a = generate_defn_name(a, source_names, also_used_names, extra_vars_pos); } SCHEME_VEC_ELS(defn_syms)[i] = a; - a = extract_source_name(e); + a = extract_source_name(e, 0); if (!SAME_OBJ(a, SCHEME_VEC_ELS(defn_syms)[i])) source_names = scheme_hash_tree_set(source_names, SCHEME_VEC_ELS(defn_syms)[i], a); else