From b942a21846ba5cfe428f5915409a19363c9a303c Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 3 Sep 2014 11:52:08 +0200
Subject: [PATCH] fix module-code caching

Fixes a problem with c4508ad0d9, which disabled module-code
caching too often. A symptom of the disabled cache was that
running "math/scribblings/math.scrbl" would use twice
as much memory.
---
 .../racket-test/tests/racket/module.rktl      | 81 ++++++++++++++-----
 racket/src/racket/src/module.c                |  4 +-
 2 files changed, 63 insertions(+), 22 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl
index e62772a828..92034ac333 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl
@@ -1163,6 +1163,27 @@
 ;; Check that module caching doesn't cause submodules
 ;; to be loaded/declared too early
 
+(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")]))
+
 (let ()
   (define dir (find-system-path 'temp-dir))
   (define tmx (build-path dir "tmx.rkt"))
@@ -1173,27 +1194,6 @@
   (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)
@@ -1216,6 +1216,45 @@
     (test 1 dynamic-require `(submod ,tmx s) 'x))
   (delete-file zo-path))
 
+;; Check that module-code caching works
+(let ()
+  (define dir (find-system-path 'temp-dir))
+  (define tmx (build-path dir "tmx2.rkt"))
+  (define e (compile '(module tmx2 racket/kernel
+                        (#%provide x)
+                        (define-values (x) 1))))
+  (make-directory* (build-path dir "compiled"))
+  (define zo-path (build-path dir "compiled" "tmx2_rkt.zo"))
+
+  (define bstr
+    (let ([b (open-output-bytes)])
+      (write e b)
+      (let* ([s (get-output-bytes b)])
+        (install-module-hashes! s 0 (bytes-length s) 100)
+        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)))))
+
+  ;; Mangle the bytecode file; cached variant should be used:
+  (call-with-output-file zo-path
+    #:exists 'update
+    (lambda (o)
+      (file-position o (- (file-size zo-path) 100))
+      (write-bytes (make-bytes 100 (char->integer #\!)) o)))
+
+  (test 2 add1
+        (parameterize ([current-namespace (make-base-namespace)])
+          (dynamic-require tmx 'x)))
+  (delete-file zo-path))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)
diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c
index 29a56ff96a..f6b199f1dd 100644
--- a/racket/src/racket/src/module.c
+++ b/racket/src/racket/src/module.c
@@ -6497,7 +6497,9 @@ 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 && !m->pre_submodules && !m->post_submodules) {
+  if (set_cache && m->code_key
+      && (!m->pre_submodules || SCHEME_NULLP(m->pre_submodules))
+      && (!m->post_submodules || SCHEME_NULLP(m->post_submodules))) {
     if (!scheme_module_code_cache) {
       REGISTER_SO(scheme_module_code_cache);
       scheme_module_code_cache = scheme_make_weak_equal_table();