From 551fd1c68d903f98f283d83d832e052174615b4b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 16 Apr 2013 11:04:42 -0600
Subject: [PATCH] DrRacket: disable "compiled/drracket" during skipped-file
 load

If DrRacket decides to skip a file for "populate compiled",
then there may exist a file in "compiled/drracket", anyway,
or there may be such a file for some depenency of the skipped
file. Before this patch, that situation was considered to be a
broken installation, and things would go bad in the likely
case that the "compiled/drracket" files were out of date.

To avoid that problem, parameterize `used-compiled-file-paths'
to drop the DrRacket "populate compiled" target while loading
the skipped file.

This change sets up a more selective "populate compiled" where
a package's modules might switch between eligible and
ineligible for compilation by DrRacket.
---
 collects/drracket/private/eval-helpers.rkt    | 53 ++++++++++++-------
 collects/tests/drracket/populate-compiled.rkt | 14 ++++-
 2 files changed, 48 insertions(+), 19 deletions(-)

diff --git a/collects/drracket/private/eval-helpers.rkt b/collects/drracket/private/eval-helpers.rkt
index aae20c13b6..13eb6df4e4 100644
--- a/collects/drracket/private/eval-helpers.rkt
+++ b/collects/drracket/private/eval-helpers.rkt
@@ -68,29 +68,46 @@
   (compile-context-preservation-enabled (prefab-module-settings-full-trace? settings))
   
   (when (prefab-module-settings-compilation-on? settings)
-    (case (prefab-module-settings-annotations settings)
-      [(none)
-       (use-compiled-file-paths
-        (cons (build-path "compiled" "drracket")
-              (use-compiled-file-paths)))]
-      [(debug)
-       (use-compiled-file-paths
-        (cons (build-path "compiled" "drracket" "errortrace")
-              (use-compiled-file-paths)))])
+    (define skip-path?
+      (let* ([cd (find-collects-dir)]
+             [no-dirs (if cd 
+                          (list (CACHE-DIR) cd)
+                          (list (CACHE-DIR)))])
+        (λ (p) (or (file-stamp-in-paths p no-dirs)
+                   (let ([pkg (path->pkg p)])
+                     (and pkg
+                          (file-stamp-in-paths p (list (pkg-directory pkg)))))))))
+    (define extra-compiled-file-path
+      (case (prefab-module-settings-annotations settings)
+        [(none) (build-path "compiled" "drracket")]
+        [(debug) (build-path "compiled" "drracket" "errortrace")]
+        [else #f]))
+    (when extra-compiled-file-path
+      ;; Add extra compiled-file path:
+      (use-compiled-file-paths
+       (cons extra-compiled-file-path
+             (use-compiled-file-paths)))
+      ;; If we ever skip a file, then don't use the extra compiled-file
+      ;; path for the skipped file's dependencies (because modules
+      ;; compiled against the non-DrRacket-generated bytecode might not
+      ;; work with any DrRacket-generated bytecode that is sitting around):
+      (current-load/use-compiled
+       (let ([orig (current-load/use-compiled)])
+         (lambda (path mod-name)
+           (if (and (member extra-compiled-file-path (use-compiled-file-paths))
+                    (skip-path? path))
+               (parameterize ([use-compiled-file-paths
+                               (remove extra-compiled-file-path 
+                                       (use-compiled-file-paths))])
+                 (orig path mod-name))
+               (orig path mod-name))))))
+    ;; Install the compilation manager:
     (parallel-lock-client module-language-parallel-lock-client)
     (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler 
                                 #t
                                 #:security-guard (and use-current-security-guard?
                                                       (current-security-guard))))
-    (let* ([cd (find-collects-dir)]
-           [no-dirs (if cd 
-                        (list (CACHE-DIR) cd)
-                        (list (CACHE-DIR)))])
-      (manager-skip-file-handler
-       (λ (p) (or (file-stamp-in-paths p no-dirs)
-                  (let ([pkg (path->pkg p)])
-                    (and pkg
-                         (file-stamp-in-paths p (list (pkg-directory pkg)))))))))))
+    (manager-skip-file-handler skip-path?)))
 
 (define (transform-module filename stx raise-hopeless-syntax-error)
   (define-values (mod name lang body)
diff --git a/collects/tests/drracket/populate-compiled.rkt b/collects/tests/drracket/populate-compiled.rkt
index 6718c46351..f2048afacf 100644
--- a/collects/tests/drracket/populate-compiled.rkt
+++ b/collects/tests/drracket/populate-compiled.rkt
@@ -91,4 +91,16 @@
 
         (check-compiled #t (build-path dir "compiled" "drracket" "errortrace" "y_rkt.zo"))
         (check-compiled #f popcomp-main-zo)
-        (check-compiled #f (build-path dir "popcomp2-pkg" "popcomp2" "compiled" "drracket" "errortrace" "main_rkt.zo"))))))
+        (check-compiled #f (build-path dir "popcomp2-pkg" "popcomp2" "compiled" "drracket" "errortrace" "main_rkt.zo"))
+
+        ;; Create a broken ".zo" file where it should not be used:
+        (make-directory* (path-only popcomp-main-zo))
+        (call-with-output-file* 
+         popcomp-main-zo
+         (lambda (o)
+           (fprintf o "broken\n")))
+
+        (do-execute drs)
+        (let* ([got (fetch-output drs)])
+          (unless (string=? "" got)
+            (error 'check-output "wrong output: ~s" got)))))))