From c4508ad0d9d577cbf00cc307833d0ba3a973ce13 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 11 Aug 2014 10:26:09 +0100
Subject: [PATCH] avoid cross-namespace submodule pollution via module-code
 cache

When a module is loaded with submodules intact, it should not be
cached and used for a later load that is intended to obtain the
module without submodules. Avoid mismatches by constraining the
cache to modules without submodules.
---
 .../racket-test/tests/racket/module.rktl      | 57 +++++++++++++++++++
 racket/src/racket/src/module.c                |  2 +-
 racket/src/racket/src/portfun.c               |  2 +-
 3 files changed, 59 insertions(+), 2 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl
index df04da458a..e62772a828 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl
@@ -1159,6 +1159,63 @@
     (parameterize ([current-namespace (make-base-namespace)])
       (eval (mk m wrap?)))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check that module caching doesn't cause submodules
+;; to be loaded/declared too early
+
+(let ()
+  (define dir (find-system-path 'temp-dir))
+  (define tmx (build-path dir "tmx.rkt"))
+  (define e (compile '(module tmx racket/base
+                        (module s racket/base
+                          (provide x)
+                          (define x 1)))))
+  (make-directory* (build-path dir "compiled"))
+  (define zo-path (build-path dir "compiled" "tmx_rkt.zo"))
+
+  (define (install-module-hashes! s start len c)
+    (define vlen (bytes-ref s (+ start 2)))
+    (define mode (integer->char (bytes-ref s (+ start 3 vlen))))
+    (case mode
+      [(#\T)
+       (define h (make-bytes 20 (+ 42 c)))
+       (bytes-copy! s (+ start 4 vlen) h)]
+      [(#\D)
+       (define (read-num rel-pos)
+         (define pos (+ start rel-pos))
+         (integer-bytes->integer s #t #f pos (+ pos 4)))
+       (define count (read-num (+ 4 vlen)))
+       (for/fold ([pos (+ 8 vlen)]) ([i (in-range count)])
+         (define pos-pos (+ pos 4 (read-num pos)))
+         (define mod-start (read-num pos-pos))
+         (define mod-len (read-num (+ pos-pos 4)))
+         (install-module-hashes! s (+ start mod-start) mod-len i)
+         (+ pos-pos 16))
+       (void)]
+      [else (error "unknown")]))
+
+  (define bstr
+    (let ([b (open-output-bytes)])
+      (write e b)
+      (let* ([s (get-output-bytes b)])
+        (install-module-hashes! s 0 (bytes-length s) 0)
+        s)))
+
+  (call-with-output-file zo-path
+    #:exists 'truncate
+    (lambda (o)
+      (write-bytes bstr o)))
+  (parameterize ([current-namespace (make-base-namespace)]
+                 [current-module-declare-name (make-resolved-module-path tmx)]
+                 [current-load-relative-directory dir])
+    (eval (parameterize ([read-accept-compiled #t])
+            (read (open-input-bytes bstr)))))
+  (parameterize ([current-namespace (make-base-namespace)])
+    (dynamic-require tmx #f)
+    (test #f module-declared? `(submod ,tmx s) #f)
+    (test 1 dynamic-require `(submod ,tmx s) 'x))
+  (delete-file zo-path))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)
diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c
index fdb83a93d7..29a56ff96a 100644
--- a/racket/src/racket/src/module.c
+++ b/racket/src/racket/src/module.c
@@ -6497,7 +6497,7 @@ static Scheme_Object *do_module_execute(Scheme_Object *data, Scheme_Env *genv,
   m = MALLOC_ONE_TAGGED(Scheme_Module);
   memcpy(m, data, sizeof(Scheme_Module));
 
-  if (set_cache && m->code_key) {
+  if (set_cache && m->code_key && !m->pre_submodules && !m->post_submodules) {
     if (!scheme_module_code_cache) {
       REGISTER_SO(scheme_module_code_cache);
       scheme_module_code_cache = scheme_make_weak_equal_table();
diff --git a/racket/src/racket/src/portfun.c b/racket/src/racket/src/portfun.c
index 64a89493f5..b7be74c9dc 100644
--- a/racket/src/racket/src/portfun.c
+++ b/racket/src/racket/src/portfun.c
@@ -4544,7 +4544,7 @@ static Scheme_Object *do_load_handler(void *data)
     }
   }
 
-  if (scheme_module_code_cache) {
+  if (scheme_module_code_cache && SCHEME_TRUEP(modname)) {
     intptr_t got;
     int vers_size, hash_header_size;
 #   define HASH_HEADER_SIZE (4 + 20 + 16)