Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

1.0.13.45: close the fd before deleting / moving files on CLOSE :ABORT T

 * Windows is not happy about files with open handles dancing around.
   This should one of the SB-COVER problems on Windows, and is
   arguably better for posixoid platforms as well.

 * SET-CLOSED-FLAME immediately after closing the fd, since that is in
   a very real sense the boundary after which doing stream operations
   is going to lose.

 * Windows additions to .gitignore.
  • Loading branch information...
commit 031646c3b8236eb441434664e10fb88f8e7ec7be 1 parent 3ca67be
@nikodemus nikodemus authored
Showing with 75 additions and 60 deletions.
  1. +3 −0  .gitignore
  2. +1 −0  NEWS
  3. +70 −59 src/code/fd-stream.lisp
  4. +1 −1  version.lisp-expr
View
3  .gitignore
@@ -28,7 +28,10 @@ src/runtime/target-os.h
tests/test-status.lisp-expr
tools-for-build/grovel-headers
tools-for-build/grovel-headers.exe
+tools-for-build/os-provides-putwc-test
+tools-for-build/os-provides-putwc-test.exe
contrib/*/test-passed
contrib/*/foo.c
contrib/*/a.out
+contrib/*/a.exe
contrib/sb-cover/test-output
View
1  NEWS
@@ -19,6 +19,7 @@ changes in sbcl-1.0.14 relative to sbcl-1.0.13:
single-floats on 64-bit platforms where single-floats are not boxed.
* bug fix: SB-MOP:CLASS-SLOTS now signals an error if the class has not
yet been finalized. (reported by Levente Meszaros)
+ * bug fix: CLOSE :ABORT T behaves more correctly on Windows.
* DESCRIBE and (DOCUMENTATION ... 'OPTIMIZE) describe meaning of
SBCL-specific optimize qualities.
View
129 src/code/fd-stream.lisp
@@ -1950,20 +1950,26 @@
input-type
output-type))))))
-;;; Handles the resource-release aspects of stream closing.
+;;; Handles the resource-release aspects of stream closing, and marks
+;;; it as closed.
(defun release-fd-stream-resources (fd-stream)
(handler-case
(without-interrupts
+ ;; Drop handlers first.
+ (when (fd-stream-handler fd-stream)
+ (remove-fd-handler (fd-stream-handler fd-stream))
+ (setf (fd-stream-handler fd-stream) nil))
;; Disable interrupts so that a asynch unwind will not leave
;; us with a dangling finalizer (that would close the same
- ;; --possibly reassigned-- FD again).
+ ;; --possibly reassigned-- FD again), or a stream with a closed
+ ;; FD that appears open.
(sb!unix:unix-close (fd-stream-fd fd-stream))
+ (set-closed-flame fd-stream)
(when (fboundp 'cancel-finalization)
(cancel-finalization fd-stream)))
;; On error unwind from WITHOUT-INTERRUPTS.
(serious-condition (e)
(error e)))
-
;; Release all buffers. If this is undone, or interrupted,
;; we're still safe: buffers have finalizers of their own.
(release-fd-stream-buffers fd-stream))
@@ -2036,66 +2042,71 @@
(setf (fd-stream-listen fd-stream) t))
(:close
(cond (arg1 ; We got us an abort on our hands.
- (when (fd-stream-handler fd-stream)
- (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 fd-stream))
- (if (fd-stream-original fd-stream)
- ;; 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.
+ (let ((outputp (fd-stream-obuf fd-stream))
+ (file (fd-stream-file fd-stream))
+ (orig (fd-stream-original fd-stream)))
+ ;; This takes care of the important stuff -- everything
+ ;; rest is cleaning up the file-system, which we cannot
+ ;; do on some platforms as long as the file is open.
+ (release-fd-stream-resources 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.
+ (when (and outputp file)
+ (if orig
+ ;; If the original is EQ to file we are appending to
+ ;; and can just close the file without renaming.
+ (unless (eq orig file)
+ ;; We have a handle on the original, just revert.
+ (multiple-value-bind (okay err)
+ (sb!unix:unix-rename orig file)
+ ;; FIXME: Why is this a SIMPLE-STREAM-ERROR, and the
+ ;; others are SIMPLE-FILE-ERRORS? Surely they should
+ ;; all be the same?
+ (unless okay
+ (error 'simple-stream-error
+ :format-control
+ "~@<Couldn't restore ~S to its original contents ~
+ from ~S while closing ~S: ~2I~_~A~:>"
+ :format-arguments
+ (list file orig fd-stream (strerror err))
+ :stream fd-stream))))
+ ;; 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-rename (fd-stream-original fd-stream)
- (fd-stream-file fd-stream))
+ (sb!unix:unix-unlink file)
(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
- (error 'simple-file-error
- :pathname (fd-stream-file fd-stream)
- :format-control
- "~@<couldn't remove ~S: ~2I~_~A~:>"
- :format-arguments (list (fd-stream-file fd-stream)
- (strerror err))))))))
+ (error 'simple-file-error
+ :pathname file
+ :format-control
+ "~@<Couldn't remove ~S while closing ~S: ~2I~_~A~:>"
+ :format-arguments
+ (list file fd-stream (strerror err)))))))))
(t
(finish-fd-stream-output fd-stream)
- (when (and (fd-stream-original fd-stream)
- (fd-stream-delete-original fd-stream))
- (multiple-value-bind (okay err)
- (sb!unix:unix-unlink (fd-stream-original fd-stream))
- (unless okay
- (error 'simple-file-error
- :pathname (fd-stream-original fd-stream)
- :format-control
- "~@<couldn't delete ~S during close of ~S: ~
- ~2I~_~A~:>"
- :format-arguments
- (list (fd-stream-original fd-stream)
- fd-stream
- (strerror err))))))))
- (release-fd-stream-resources fd-stream)
- ;; Mark as closed. FIXME: Maybe this should be the first thing done?
- (sb!impl::set-closed-flame fd-stream))
+ (let ((orig (fd-stream-original fd-stream)))
+ (when (and orig (fd-stream-delete-original fd-stream))
+ (multiple-value-bind (okay err) (sb!unix:unix-unlink orig)
+ (unless okay
+ (error 'simple-file-error
+ :pathname orig
+ :format-control
+ "~@<couldn't delete ~S while closing ~S: ~2I~_~A~:>"
+ :format-arguments
+ (list orig fd-stream (strerror err)))))))
+ ;; In case of no-abort close, don't *really* close the
+ ;; stream until the last moment -- the cleaning up of the
+ ;; original can be done first.
+ (release-fd-stream-resources fd-stream))))
(:clear-input
(fd-stream-clear-input fd-stream))
(:force-output
View
2  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.13.44"
+"1.0.13.45"
Please sign in to comment.
Something went wrong with that request. Please try again.