From 92b4e8878efe6b6fc7b39741632a9f8bf8628c94 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 20 Apr 2005 18:53:08 +0000
Subject: [PATCH] .

original commit: 43bb54067138e87c298921548a3649f7446b1840
---
 collects/mzlib/file.ss | 43 +++++++++++++++++++++++++-----------------
 1 file changed, 26 insertions(+), 17 deletions(-)

diff --git a/collects/mzlib/file.ss b/collects/mzlib/file.ss
index 5407e14..786cdd2 100644
--- a/collects/mzlib/file.ss
+++ b/collects/mzlib/file.ss
@@ -421,23 +421,32 @@
 				    "TMPPREF~a"
 				    (and (file-exists? pref-file) pref-file)
 				    pref-dir)])
-		    (with-output-to-file tmp-file
-		      (lambda ()
-			(with-pref-params
-			 (lambda ()
-			   ;; Poor man's pretty-print: one line per entry
-			   (printf "(~n")
-			   (for-each (lambda (a)
-				       (if (list? (cadr a))
-					   (begin
-					     (printf " (~s~n  (~n" (car a))
-					     (for-each (lambda (i) (printf "  ~s~n" i)) (cadr a))
-					     (printf "  ))~n"))
-					   (printf " ~s~n" a)))
-				     f)
-			   (printf ")~n"))))
-		      'truncate/replace)
-		    (rename-file-or-directory tmp-file pref-file #t))))
+		    ;; If something goes wrong, try to delete the temp file.
+		    (with-handlers ([exn:fail? (lambda (exn)
+						 (with-handlers ([exn:fail:filesystem? void])
+						   (delete-file tmp-file))
+						 (raise exn))])
+		      ;; Write to temp file...
+		      (with-output-to-file tmp-file
+			(lambda ()
+			  (with-pref-params
+			   (lambda ()
+			     ;; If a pref value turns out to be unreadable, raise
+			     ;;  an exception instead of creating a bad pref file.
+			     (parameterize ([print-unreadable #f])
+			       ;; Poor man's pretty-print: one line per entry.
+			       (printf "(~n")
+			       (for-each (lambda (a)
+					   (if (list? (cadr a))
+					       (begin
+						 (printf " (~s~n  (~n" (car a))
+						 (for-each (lambda (i) (printf "  ~s~n" i)) (cadr a))
+						 (printf "  ))~n"))
+					       (printf " ~s~n" a)))
+					 f)
+			       (printf ")~n")))))
+			'truncate/replace)
+		      (rename-file-or-directory tmp-file pref-file #t)))))
 	      (lambda ()
 		;; Release lock:
 		(delete-file lock-file)))))]