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

when writing a .zo fails, delete the bad file

Browse Source 
svn: r2310
This commit is contained in:
Matthew Flatt 2006-02-23 20:53:41 +00:00
parent fa6a2c009c
commit 6ddea0a0f5
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/mzlib/cm.ss
View File

@ -53,6 +53,13 @@
((eq? 'relative base) mode)
(else (build-path base mode)))))
(define (try-delete-file path)
;; Attempt to delete, but give up if it
;; doesn't work:
(with-handlers ([exn:fail:filesystem? void])
(trace-printf "deleting: ~a" path)
(delete-file path)))
;; with-compile-output : path (output-port -> alpha) -> alpha
;; Open path for writing, and arranges to delete path if there's
;; an exception. Breaks are managed so that the port is reliably
@ -60,11 +67,7 @@
(define (with-compile-output path proc)
(let ([bp (current-break-parameterization)])
(with-handlers ([void (lambda (exn)
;; Attempt to delete, but give up if it
;; doesn't work:
(with-handlers ([exn:fail:filesystem? void])
(trace-printf "deleting: ~a" path)
(delete-file path))
(try-delete-file path)
(raise exn))])
(let ([out (open-output-file path 'truncate/replace)])
(dynamic-wind
@ -137,7 +140,10 @@
zo-name
(lambda (out)
(with-handlers ((exn:fail?
(lambda (ex) (compilation-failure mode path zo-name #f (exn-message ex)))))
(lambda (ex)
(close-output-port out)
(try-delete-file zo-name)
(compilation-failure mode path zo-name #f (exn-message ex)))))
(parameterize ([current-write-relative-directory
(let-values ([(base name dir?) (split-path path)])
(if (eq? base 'relative)