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

raco setup: less eager removal of ".zo" files

Browse Source 
Wait until replacement is more assured before deleting an existing
".zo" file.

Also, don't delete a ".zo" file that is later in the
`current-compiled-file-roots` search path than the one being written.
This refinement supports setting up a search path to try
machine-specific compiled files and fall back to machine-independent
files, for example.
This commit is contained in:
Matthew Flatt 2018-11-24 16:45:51 -07:00
parent f4a08af16b
commit 055642a40a
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
racket/collects/compiler/private/cm-minimal.rkt
View File

@ -241,10 +241,10 @@
;; compute one hash from all hashes ;; compute one hash from all hashes
(sha1 (get-output-bytes p)))))) (sha1 (get-output-bytes p))))))
(define (write-deps code path->mode roots path src-sha1 (define (write-deps code zo-name path->mode roots path src-sha1
external-deps external-module-deps reader-deps external-deps external-module-deps reader-deps
up-to-date collection-cache read-src-syntax) up-to-date collection-cache read-src-syntax)
(let ([dep-path (path-add-extension (get-compilation-path path->mode roots path) #".dep")] (let ([dep-path (path-replace-extension zo-name #".dep")]
[deps (remove-duplicates (append (get-deps code path) [deps (remove-duplicates (append (get-deps code path)
external-module-deps ; can create cycles if misused! external-module-deps ; can create cycles if misused!
reader-deps))] reader-deps))]
@ -272,8 +272,8 @@
op) op)
(newline op)))))) (newline op))))))
(define (write-updated-deps deps assume-compiled-sha1 path->mode roots path) (define (write-updated-deps deps assume-compiled-sha1 zo-name)
(let ([dep-path (path-add-extension (get-compilation-path path->mode roots path) #".dep")]) (let ([dep-path (path-replace-extension zo-name #".dep")])
(with-compile-output dep-path (with-compile-output dep-path
(lambda (op tmp-path) (lambda (op tmp-path)
(write (list* (version) (write (list* (version)
@ -393,7 +393,8 @@
collection-cache)] collection-cache)]
[else [else
(get-module-code path (path->mode path) compile (get-module-code path (path->mode path) compile
(lambda (a b) #f) ; extension handler #:choose (lambda (src zo so) 'src)
#:extension-handler (lambda (a b) #f)
#:roots (list (car roots)) #:roots (list (car roots))
#:source-reader read-src-syntax)])))) #:source-reader read-src-syntax)]))))
(define dest-roots (list (car roots))) (define dest-roots (list (car roots)))
@ -459,14 +460,18 @@
(write-bytes s out))))) (write-bytes s out)))))
;; redundant, but close as early as possible: ;; redundant, but close as early as possible:
(close-output-port out) (close-output-port out)
;; Note that we check time and write .deps before returning from ;; Note that we check time and write ".dep" before returning from
;; with-compile-output... ;; with-compile-output...
(verify-times path tmp-name) (verify-times path tmp-name)
;; Explicitly delete target file before writing ".dep", just so
;; ".dep" is doesn't claim a description of the wrong file
(when (file-exists? zo-name)
(try-delete-file zo-name #f))
(cond (cond
[use-existing-deps [use-existing-deps
(write-updated-deps use-existing-deps assume-compiled-sha1 path->mode roots path)] (write-updated-deps use-existing-deps assume-compiled-sha1 zo-name)]
[else [else
(write-deps code path->mode dest-roots path src-sha1 (write-deps code zo-name path->mode dest-roots path src-sha1
external-deps external-module-deps reader-deps external-deps external-module-deps reader-deps
up-to-date collection-cache read-src-syntax)]))) up-to-date collection-cache read-src-syntax)])))
(trace-printf "wrote zo file: ~a" zo-name))) (trace-printf "wrote zo file: ~a" zo-name)))
@ -556,9 +561,6 @@
(lambda () (lambda ()
(when ok-to-compile? (when ok-to-compile?
(log-compile-event path (if recompile-from 'start-recompile 'start-compile)) (log-compile-event path (if recompile-from 'start-recompile 'start-compile))
(when zo-exists?
(unless (equal? zo-name recompile-from)
(try-delete-file zo-name #f)))
(trace-printf "~acompiling ~a" (if recompile-from "re" "") actual-path) (trace-printf "~acompiling ~a" (if recompile-from "re" "") actual-path)
(parameterize ([depth (+ (depth) 1)]) (parameterize ([depth (+ (depth) 1)])
(with-handlers ([exn:get-module-code? (with-handlers ([exn:get-module-code?