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

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)

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))
+  if (!a || !SCHEME_SYMBOLP(a)) {
-    a = SCHEME_STX_SYM(e);
+    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]))
+    /* Alternative source name supplied? */
-      source_names = scheme_hash_tree_set(source_names, SCHEME_VEC_ELS(defn_syms)[j], a);
+    a = extract_source_name(e, 1);
-    else
+    if (a) {
-      also_used_names = scheme_hash_tree_set(also_used_names, a, scheme_true);
+      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