fix namespace-mapped-symbols forcing of lazy binding info

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

@@ -1670,6 +1670,39 @@ case of module-leve bindings; it doesn't cover local bindings.
         #;(log-error "go")
         (eval #f))))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check `namespace-mapped-symbols` and modidx shifting
+
+(let ()
+  (define tmp (make-temporary-file "~a-module-test" 'directory))
+  (parameterize ([current-directory tmp]
+                 [current-load-relative-directory tmp])
+    (make-directory "compiled")
+    (call-with-output-file*
+     "compiled/a_rkt.zo"
+     (lambda (o) (write (compile '(module a racket/base
+                              (provide (all-defined-out))
+                              (define a 1)
+                              (define b 2)
+                              (define c 3)))
+                   o)))
+    (call-with-output-file*
+     "compiled/b_rkt.zo"
+     (lambda (o) (write (compile '(module b racket/base
+                              (require "a.rkt"
+                                       ;; Force saving of context, instead of
+                                       ;; reconstruction:
+                                       (only-in racket/base [car extra-car]))))
+                   o))))
+  (dynamic-require (build-path tmp "b.rkt") #f)
+  (define ns (module->namespace (build-path tmp "b.rkt")))
+  (test #t
+        'mapped-symbols
+        (and (for/and ([name '(a b c)])
+               (member name (namespace-mapped-symbols ns)))
+             #t))
+  (delete-directory/files tmp))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/src/racket/src/syntax.c

@@ -154,7 +154,8 @@ static void register_traversers(void);
 XFORM_NONGCING static int is_armed(Scheme_Object *v);
 static Scheme_Object *add_taint_to_stx(Scheme_Object *o, int *mutate);
 
-static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *vec, Scheme_Scope_Set *scopes, Scheme_Object *replace_at);
+static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *shifts,
+                                               Scheme_Object *vec, Scheme_Scope_Set *scopes, Scheme_Object *replace_at);
 
 static Scheme_Object *make_unmarshal_info(Scheme_Object *phase, Scheme_Object *prefix, Scheme_Object *excepts);
 XFORM_NONGCING static Scheme_Object *extract_unmarshal_phase(Scheme_Object *unmarshal_info);
@@ -3491,7 +3492,7 @@ char *scheme_stx_describe_context(Scheme_Object *stx, Scheme_Object *phase, int
     return "";
 }
 
-static void add_scopes_mapped_names(Scheme_Scope_Set *scopes, Scheme_Hash_Table *mapped)
+static void add_scopes_mapped_names(Scheme_Scope_Set *scopes, Scheme_Object *shifts, Scheme_Hash_Table *mapped)
 {
   int retry;
   Scheme_Hash_Tree *ht;
@@ -3554,7 +3555,7 @@ static void add_scopes_mapped_names(Scheme_Scope_Set *scopes, Scheme_Hash_Table
             pes = SCHEME_BINDING_VAL(SCHEME_CAR(l));
             if (PES_UNMARSHAL_DESCP(pes)) {
               if (SCHEME_TRUEP(SCHEME_VEC_ELS(pes)[0])) {
-                unmarshal_module_context_additions(NULL, pes, binding_scopes, l);
+                unmarshal_module_context_additions(NULL, shifts, pes, binding_scopes, l);
                 retry = 1;
               }
             } else {
@@ -3651,7 +3652,7 @@ static Scheme_Object *do_stx_lookup(Scheme_Stx *stx, Scheme_Scope_Set *scopes,
                   /* Need unmarshal --- but only if the scope set is relevant */
                   if (scope_subset(binding_scopes, scopes)) {
                     /* unmarshal and note that we must restart */
-                    unmarshal_module_context_additions(stx, pes, binding_scopes, l);
+                    unmarshal_module_context_additions(stx, NULL, pes, binding_scopes, l);
                     invalid = 1;
                     /* Shouldn't encounter this on a second pass: */
                     STX_ASSERT(!check_subset);
@@ -4289,7 +4290,9 @@ Scheme_Object *scheme_module_context_inspector(Scheme_Object *mc)
 
 void scheme_module_context_add_mapped_symbols(Scheme_Object *mc, Scheme_Hash_Table *mapped)
 {
-  add_scopes_mapped_names(scheme_module_context_scopes(mc), mapped);
+  add_scopes_mapped_names(scheme_module_context_scopes(mc),
+                          SCHEME_VEC_ELS(mc)[3], /* list of shifts */
+                          mapped);
 }
 
 Scheme_Object *scheme_module_context_at_phase(Scheme_Object *mc, Scheme_Object *phase)
@@ -4750,7 +4753,8 @@ static Scheme_Object *unmarshal_key_adjust(Scheme_Object *sym, Scheme_Object *pe
   return sym;
 }
 
-static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *vec, Scheme_Scope_Set *scopes, Scheme_Object *replace_at)
+static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *shifts,
+                                               Scheme_Object *vec, Scheme_Scope_Set *scopes, Scheme_Object *replace_at)
 {
   Scheme_Object *req_modidx, *modidx, *unmarshal_info, *context, *src_phase, *pt_phase, *bind_phase;
   Scheme_Object *insp, *req_insp;
@@ -4760,14 +4764,10 @@ static void unmarshal_module_context_additions(Scheme_Stx *stx, Scheme_Object *v
   insp = SCHEME_VEC_ELS(vec)[3];
   req_insp = insp;
 
-  if (stx) {
+  if (stx)
     modidx = apply_modidx_shifts(stx->shifts, req_modidx, &insp, &export_registry);
-  } else {
+  else
-    modidx = req_modidx;
+    modidx = apply_modidx_shifts(shifts, req_modidx, &insp, &export_registry);
-    export_registry = NULL;
-    insp = scheme_false;
-    req_insp = scheme_false;
-  }
 
   src_phase = SCHEME_VEC_ELS(vec)[1];
   unmarshal_info = SCHEME_VEC_ELS(vec)[2];