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

do not write .fail files

Browse Source 
svn: r9494
This commit is contained in:
Matthew Flatt 2008-04-26 16:24:25 +00:00
parent b9054b366b
commit c14a965ebd
1 changed files with 8 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/mzlib/cm.ss
View File

@ -101,11 +101,6 @@
(define (compilation-failure mode path zo-name date-path reason) (define (compilation-failure mode path zo-name date-path reason)
(with-handlers ((exn:fail:filesystem? void)) (with-handlers ((exn:fail:filesystem? void))
(delete-file zo-name)) (delete-file zo-name))
(let ([fail-path (path-add-suffix (get-compilation-path mode path) #".fail")])
(with-compile-output
fail-path
(lambda (p)
(display reason p))))
(trace-printf "failure")) (trace-printf "failure"))
(define (compile-zo mode path read-src-syntax) (define (compile-zo mode path read-src-syntax)
@ -121,7 +116,8 @@
(lambda (ex) (lambda (ex)
(compilation-failure (compilation-failure
mode path zo-name (exn:get-module-code-path ex) mode path zo-name (exn:get-module-code-path ex)
(exn-message ex)))]) (exn-message ex))
(raise ex))])
(let* ([param (let* ([param
;; Avoid using cm while loading cm-ctime: ;; Avoid using cm while loading cm-ctime:
(parameterize ([use-compiled-file-paths null]) (parameterize ([use-compiled-file-paths null])
@ -155,8 +151,8 @@
(with-handlers ((exn:fail? (with-handlers ((exn:fail?
(lambda (ex) (lambda (ex)
(close-output-port out) (close-output-port out)
(try-delete-file zo-name) (compilation-failure mode path zo-name #f (exn-message ex))
(compilation-failure mode path zo-name #f (exn-message ex))))) (raise ex))))
(parameterize ([current-write-relative-directory (parameterize ([current-write-relative-directory
(let-values ([(base name dir?) (split-path path)]) (let-values ([(base name dir?) (split-path path)])
(if (eq? base 'relative) (if (eq? base 'relative)
@ -195,12 +191,11 @@
(define (append-object-suffix f) (define (append-object-suffix f)
(path-add-suffix f (system-type 'so-suffix))) (path-add-suffix f (system-type 'so-suffix)))
(define (get-compiled-time mode path w/fail?) (define (get-compiled-time mode path)
(let*-values ([(dir name) (get-compilation-dir+name mode path)]) (let*-values ([(dir name) (get-compilation-dir+name mode path)])
(first-date (first-date
(lambda () (build-path dir "native" (system-library-subpath) (append-object-suffix name))) (lambda () (build-path dir "native" (system-library-subpath) (append-object-suffix name)))
(lambda () (build-path dir (path-add-suffix name #".zo"))) (lambda () (build-path dir (path-add-suffix name #".zo"))))))
(and w/fail? (lambda () (build-path dir (path-add-suffix name #".fail")))))))
(define first-date (define first-date
(case-lambda (case-lambda
@ -222,7 +217,7 @@
(stamp stamp) (stamp stamp)
(else (else
(trace-printf "checking: ~a" path) (trace-printf "checking: ~a" path)
(let ((path-zo-time (get-compiled-time mode path #f)) (let ((path-zo-time (get-compiled-time mode path))
(path-time (path-time
(with-handlers ((exn:fail:filesystem? (with-handlers ((exn:fail:filesystem?
(lambda (ex) (lambda (ex)
@ -271,7 +266,7 @@
(main-collects-relative->path p))) (main-collects-relative->path p)))
(cdr deps))) (cdr deps)))
(compile-zo mode path read-src-syntax)))))) (compile-zo mode path read-src-syntax))))))
(let ((stamp (get-compiled-time mode path #t))) (let ((stamp (get-compiled-time mode path)))
(hash-set! up-to-date path stamp) (hash-set! up-to-date path stamp)
stamp))))))))) stamp)))))))))