From 8b244d668721358d4a452650a9e608149c72c8f2 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 31 Jul 2009 09:11:15 +0000
Subject: [PATCH] 1.0.30.22: better DELETE-FILE on streams

 * Don't close the stream on Unix, so users can enjoy the normal
   Unixy-IO to unlinked files.

 * On Windows, close the stream with :ABORT NIL, so that there
   is no danger of close trying to delete file as well.

   Bug with DELETE-FILE trying to delete files twice reported by
   John Fremlin.
---
 NEWS                     |  3 +++
 src/code/filesys.lisp    | 20 ++++++++++----------
 tests/stream.impure.lisp | 11 +++++++++++
 version.lisp-expr        |  2 +-
 4 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/NEWS b/NEWS
index 3071cb202..27fe085ea 100644
--- a/NEWS
+++ b/NEWS
@@ -27,6 +27,9 @@ changes relative to sbcl-1.0.30:
        documented.
     ** DECLARATION-INFORMATION now supports declaration name DECLARATION as
        well.
+  * bug fix: DELETE-FILE on streams no longer closes the stream with :ABORT T,
+    leading to possible attempts to delete the same file twice. See docstring
+    on DELETE-FILE for details. (reported by John Fremlin)
   * bug fix: the low-level debugger had 32-bit assumptions and was missing
     information about some array types. (thanks to Luis Oliveira)
   * bug fix: moderately complex combinations of inline expansions could
diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 482b34b4f..0cac4e792 100644
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -471,17 +471,17 @@ or if PATHSPEC is a wild pathname."
 
 (defun delete-file (file)
   #!+sb-doc
-  "Delete the specified FILE."
-  (let* ((truename (probe-file file))
-         (namestring (when truename
-                       (native-namestring truename :as-file t))))
+  "Delete the specified FILE.
+
+If FILE is a stream, on Windows the stream is closed immediately. On Unix
+plaforms the stream remains open, allowing IO to continue: the OS resources
+associated with the deleted file remain available till the stream is closed as
+per standard Unix unlink() behaviour."
+  (let* ((truename (truename file))
+         (namestring (native-namestring truename :as-file t)))
+    #!+win32
     (when (streamp file)
-      (close file :abort t))
-    (unless namestring
-      (error 'simple-file-error
-             :pathname file
-             :format-control "~S doesn't exist."
-             :format-arguments (list file)))
+      (close file))
     (multiple-value-bind (res err) (sb!unix:unix-unlink namestring)
       (unless res
         (simple-file-perror "couldn't delete ~A" namestring err))))
diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 3540257ab..863f4e98b 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -577,5 +577,16 @@
     (assert (let ((buffer (make-array 10 :element-type '(unsigned-byte 8))))
               (read-sequence buffer s))))
   (delete-file pathname))
+
+(with-test (:name :delete-file-on-streams)
+  (with-open-file (f "delete-file-on-stream-test.tmp"
+                     :direction :io)
+    (delete-file f)
+    #-win32
+    (progn
+      (write-line "still open" f)
+      (file-position f :start)
+      (assert (equal "still open" (read-line f)))))
+  (assert (not (probe-file "delete-file-on-stream-test.tmp"))))
 
 ;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 2f65b6cbd..7863d933d 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.30.21"
+"1.0.30.22"
-- 
2.11.4.GIT