From f9490a0cfb40cd226e03cb65a5902fe0c2590670 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 23 Feb 2006 20:53:41 +0000 Subject: [PATCH] when writing a .zo fails, delete the bad file svn: r2310 original commit: 6ddea0a0f599d81157eabd7843ef6ff05cfe08f2 --- collects/mzlib/cm.ss | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/collects/mzlib/cm.ss b/collects/mzlib/cm.ss index ee2072d..40e624e 100644 --- a/collects/mzlib/cm.ss +++ b/collects/mzlib/cm.ss @@ -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)