Skip to content
Snippets Groups Projects
Commit b5bcd12f authored by rtoy's avatar rtoy
Browse files

When reverting a file, don't delete the file if there was no

original.  This is the solution from Carl, for a bug reported by
Madhu, cmucl-imp, 2006-02-19.
parent 4fe79050
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.83 2005/04/04 14:33:17 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.84 2006/02/27 16:06:34 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1098,22 +1098,18 @@ ...@@ -1098,22 +1098,18 @@
;;; REVERT-FILE -- internal ;;; REVERT-FILE -- internal
;;; ;;;
;;; Revert a file, if possible; otherwise just delete it. Used during ;;; Revert a file, if possible; otherwise do nothing. Used during
;;; CLOSE when the abort flag is set. ;;; CLOSE when the abort flag is set.
;;; ;;;
(defun revert-file (filename original) (defun revert-file (filename original)
(declare (type simple-base-string filename) (declare (type simple-base-string filename)
(type (or simple-base-string null) original)) (type (or simple-base-string null) original))
(if original (when original
(multiple-value-bind (okay err) (unix:unix-rename original filename) (multiple-value-bind (okay err)
(unless okay (unix:unix-rename original filename)
(unless okay
(cerror "Go on as if nothing bad happened." (cerror "Go on as if nothing bad happened."
"Could not restore ~S to its original contents: ~A" "Could not restore ~S to its original contents: ~A"
filename (unix:get-unix-error-msg err))))
(multiple-value-bind (okay err) (unix:unix-unlink filename)
(unless okay
(cerror "Go on as if nothing bad happened."
"Could not remove ~S: ~A"
filename (unix:get-unix-error-msg err)))))) filename (unix:get-unix-error-msg err))))))
;;; DELETE-ORIGINAL -- internal ;;; DELETE-ORIGINAL -- internal
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment