0.8.10.40:

         Fixed bug in OPEN / CLOSE interaction that caused file deletion when
         appending stream was closed with :ABORT T.
         ... BUGS entry about similar behaviour when superseding files.
         ... Regression test for the same.

diff --git a/BUGS b/BUGS
index 175889a..d16501c 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1443,3 +1443,16 @@ WORKAROUND:
   to about 1024 (and similarly for signed-byte), so
     (open "/dev/zero" :element-type '(unsigned-byte 1025))
   gives an error in sbcl-0.8.10.
+
+325: "CLOSE :ABORT T on supeseding streams"
+  Closing a stream opened with :IF-EXISTS :SUPERSEDE with :ABORT T leaves no
+  file on disk, even if one existed before opening.
+
+  The illegality of this is not crystal clear, as the ANSI dictionary
+  entry for CLOSE says that when :ABORT is T superseded files are not
+  superseded (ie. the original should be restored), whereas the OPEN
+  entry says about :IF-EXISTS :SUPERSEDE "If possible, the
+  implementation should not destroy the old file until the new stream
+  is closed." -- implying that even though undesirable, early deletion
+  is legal. Restoring the original would none the less be the polite
+  thing to do.

diff --git a/NEWS b/NEWS
index e0e20f7..e186ee4 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2403,6 +2403,8 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10:
     SB-EXT:INHIBIT-WARNINGS OPTIMIZE quality.  See the manual for
     documentation on this feature.  The SB-EXT:INHIBIT-WARNINGS
     quality should be considered deprecated.
+  * fixed bug: CLOSE :ABORT T on appending stream no longer causes
+    file deletion.
   * fixed bug: Invalid slot specification errors now print correctly. 
     (thanks to Zach Beane)
   * fixed bug 320: Shared to local slot value transfers in class 

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 564f53b..d8a2d57 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -883,27 +883,40 @@
      (setf (fd-stream-unread fd-stream) arg1)
      (setf (fd-stream-listen fd-stream) t))
     (:close
-     (cond (arg1
-           ;; We got us an abort on our hands.
+     (cond (arg1 ; We got us an abort on our hands.
            (when (fd-stream-handler fd-stream)
-                 (sb!sys:remove-fd-handler (fd-stream-handler fd-stream))
-                 (setf (fd-stream-handler fd-stream) nil))
+             (sb!sys:remove-fd-handler (fd-stream-handler fd-stream))
+             (setf (fd-stream-handler fd-stream) nil))
+           ;; We can't do anything unless we know what file were
+           ;; dealing with, and we don't want to do anything
+           ;; strange unless we were writing to the file.
            (when (and (fd-stream-file fd-stream)
                       (fd-stream-obuf-sap fd-stream))
-             ;; We can't do anything unless we know what file were
-             ;; dealing with, and we don't want to do anything
-             ;; strange unless we were writing to the file.
              (if (fd-stream-original fd-stream)
-                 ;; We have a handle on the original, just revert.
-                 (multiple-value-bind (okay err)
-                     (sb!unix:unix-rename (fd-stream-original fd-stream)
-                                          (fd-stream-file fd-stream))
-                   (unless okay
-                     (simple-stream-perror
-                      "couldn't restore ~S to its original contents"
-                      fd-stream
-                      err)))
-                 ;; We can't restore the original, so nuke that puppy.
+                 ;; If the original is EQ to file we are appending
+                 ;; and can just close the file without renaming.
+                 (unless (eq (fd-stream-original fd-stream)
+                             (fd-stream-file fd-stream))
+                   ;; We have a handle on the original, just revert.
+                   (multiple-value-bind (okay err)
+                       (sb!unix:unix-rename (fd-stream-original fd-stream)
+                                            (fd-stream-file fd-stream))
+                     (unless okay
+                       (simple-stream-perror
+                        "couldn't restore ~S to its original contents"
+                        fd-stream
+                        err))))
+                 ;; We can't restore the original, and aren't
+                 ;; appending, so nuke that puppy.
+                 ;;
+                 ;; FIXME: This is currently the fate of superseded
+                 ;; files, and according to the CLOSE spec this is
+                 ;; wrong. However, there seems to be no clean way to
+                 ;; do that that doesn't involve either copying the
+                 ;; data (bad if the :abort resulted from a full
+                 ;; disk), or renaming the old file temporarily
+                 ;; (probably bad because stream opening becomes more
+                 ;; racy).
                  (multiple-value-bind (okay err)
                      (sb!unix:unix-unlink (fd-stream-file fd-stream))
                    (unless okay
@@ -1243,12 +1256,16 @@
       (if (eq if-does-not-exist :create)
        (setf mask (logior mask sb!unix:o_creat)))
 
-      (let ((original (if (member if-exists
-                                 '(:rename :rename-and-delete))
-                         (pick-backup-name namestring)))
+      (let ((original (case if-exists
+                       ((:rename :rename-and-delete)
+                        (pick-backup-name namestring))
+                       ((:append)
+                        ;; KLUDGE: Provent CLOSE from deleting
+                        ;; appending streams when called with :ABORT T
+                        namestring)))
            (delete-original (eq if-exists :rename-and-delete))
            (mode #o666))
-       (when original
+       (when (and original (not (eq original namestring)))
          ;; We are doing a :RENAME or :RENAME-AND-DELETE. Determine
          ;; whether the file already exists, make sure the original
          ;; file is not a directory, and keep the mode.

diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 7348bfe..598c55a 100644 (file)
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -125,5 +125,29 @@
       (assert (= 1 (file-position s))) ; unicode...
       (assert (file-position s 0))))
   (delete-file p))
+
+;;; CLOSING a non-new streams should not delete them, and superseded
+;;; files should be restored.
+(let ((test "test-file-for-close-should-not-delete"))
+  (macrolet ((test-mode (mode)
+              `(progn
+                (catch :close-test-exit
+                  (with-open-file (f test :direction :output :if-exists ,mode)
+                    (write-line "test" f)
+                    (throw :close-test-exit t)))
+                (assert (and (probe-file test) ,mode)))))
+    (unwind-protect
+        (progn
+          (with-open-file (f test :direction :output)
+            (write-line "test" f))
+          (test-mode :append)
+          ;; FIXME: We really should recover supersede files as well, according to
+          ;; CLOSE in CLHS, but at the moment we don't.
+          ;; (test-mode :supersede)
+          (test-mode :rename)
+          (test-mode :rename-and-delete))
+      (when (probe-file test)
+       (delete-file test)))))
+
 ;;; success
 (quit :unix-status 104)