suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

DrRacket: disable "compiled/drracket" during skipped-file load

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2013-04-16 11:04:42 -06:00
parent fe9350ea62
commit 551fd1c68d
2 changed files with 48 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/drracket/private/eval-helpers.rkt
View File

@ -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)

14
collects/tests/drracket/populate-compiled.rkt
View File

@ -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)))))))