fix mutation of shared "self" module path index for submodules

pkgs/racket-test-core/tests/racket/stx.rktl

@@ -2269,6 +2269,31 @@
                               (namespace-syntax-introduce (datum->syntax #f 'car)))))
          (open-output-bytes)))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check that reading a compiled module doesn't mutate the
+;; shared "self" modix for a submodule:
+
+(parameterize ([current-namespace (make-base-namespace)])
+  (define o (open-output-bytes))
+  (write (compile `(module name-1 racket/base (module+ inside))) o)
+  (define m
+    (parameterize ([read-accept-compiled #t])
+      (read (open-input-bytes (get-output-bytes o)))))
+  (define s (expand `(module name-2 racket/base (module+ inside (define check-me 1)))))
+  (test "(|expanded module| inside)"
+        format
+        "~s"
+        (resolved-module-path-name
+         (let loop ([s s])
+           (cond
+            [(identifier? s)
+             (and (equal? 'check-me (syntax-e s))
+                  (module-path-index-resolve (car (identifier-binding s))))]
+            [(syntax? s) (loop (syntax-e s))]
+            [(pair? s)
+             (or (loop (car s)) (loop (cdr s)))]
+            [else #f])))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/src/racket/src/module.c

@@ -3716,7 +3716,7 @@ static Scheme_Object *module_path_index_join(int argc, Scheme_Object *argv[])
                               "second argument", 1, argv[1],
                               "third argument", 1, argv[2],
                               NULL);
-      return scheme_get_submodule_empty_self_modidx(argv[2]);
+      return scheme_get_submodule_empty_self_modidx(argv[2], 0);
     }
   }
 
@@ -4024,31 +4024,49 @@ static Scheme_Object *resolved_module_path_to_modidx(Scheme_Object *rmp)
   return scheme_make_modidx(path, scheme_false, rmp);
 }
 
-Scheme_Object *scheme_get_submodule_empty_self_modidx(Scheme_Object *submodule_path)
+Scheme_Object *scheme_get_submodule_empty_self_modidx(Scheme_Object *submodule_path, int can_cache)
 {
   Scheme_Bucket *b;
+  Scheme_Object *modidx;
 
-  if (SCHEME_NULLP(submodule_path))
-    return empty_self_modidx;
+  if (SCHEME_NULLP(submodule_path)) {
+    if (can_cache)
+      return empty_self_modidx;
+    return scheme_make_modidx(scheme_false, scheme_false, empty_self_modname);
+  }
 
   if (!submodule_empty_modidx_table) {
     REGISTER_SO(submodule_empty_modidx_table);
     submodule_empty_modidx_table = scheme_make_weak_equal_table();
   }
 
-  scheme_start_atomic();
-  b = scheme_bucket_from_table(submodule_empty_modidx_table, (const char *)submodule_path);
-  if (!b->val) {
-    submodule_path = make_resolved_module_path_obj(scheme_make_pair(scheme_resolved_module_path_value(empty_self_modname),
-                                                                    submodule_path));
-    submodule_path = scheme_make_modidx(scheme_false, 
-                                        scheme_false,
-                                        submodule_path);
-    b->val = submodule_path;
+  if (can_cache) {
+    scheme_start_atomic();
+    b = scheme_bucket_from_table(submodule_empty_modidx_table, (const char *)submodule_path);
+    if (b->val)
+      modidx = scheme_ephemeron_value(b->val);
+    else
+      modidx = NULL;
+  } else {
+    b = NULL;
+    modidx = NULL;
   }
-  scheme_end_atomic_no_swap();
 
-  return b->val;
+  if (!modidx) {
+    modidx = make_resolved_module_path_obj(scheme_make_pair(scheme_resolved_module_path_value(empty_self_modname),
+                                                            submodule_path));
+    modidx = scheme_make_modidx(scheme_false, scheme_false, modidx);
+    if (b) {
+      modidx = scheme_make_ephemeron(submodule_path, modidx);
+      b->val = modidx;
+      modidx = scheme_ephemeron_value(modidx);
+    }
+  }
+
+  if (can_cache)
+    scheme_end_atomic_no_swap();
+
+  return modidx;
 }
 
 static Scheme_Object *_module_resolve_k(void);
@@ -7325,7 +7343,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
 
   fm = scheme_stx_property(fm, module_name_symbol, scheme_resolved_module_path_value(rmp));
 
-  this_empty_self_modidx = scheme_get_submodule_empty_self_modidx(submodule_path);
+  this_empty_self_modidx = scheme_get_submodule_empty_self_modidx(submodule_path, 1);
 
   /* phase shift to replace self_modidx of previous expansion: */
   fm = scheme_stx_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL,

racket/src/racket/src/read.c

@@ -5168,7 +5168,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
             if (SCHEME_FALSEP(path))
               return scheme_make_modidx(scheme_false, scheme_false, scheme_false);
             else
-              return scheme_get_submodule_empty_self_modidx(path);
+              return scheme_get_submodule_empty_self_modidx(path, 0);
           } else
             return scheme_make_modidx(path, base, scheme_false);
 	}

racket/src/racket/src/schpriv.h

@@ -3719,7 +3719,7 @@ Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,
 				   Scheme_Object *shift_to_modidx);
 
 Scheme_Object *scheme_modidx_submodule(Scheme_Object *modidx);
-Scheme_Object *scheme_get_submodule_empty_self_modidx(Scheme_Object *submodule_path);
+Scheme_Object *scheme_get_submodule_empty_self_modidx(Scheme_Object *submodule_path, int can_cache);
 
 #define SCHEME_RMPP(o) (SAME_TYPE(SCHEME_TYPE((o)), scheme_resolved_module_path_type))
 #define SCHEME_MODNAMEP(obj)  (SAME_TYPE(SCHEME_TYPE(obj), scheme_resolved_module_path_type))