X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-simple-streams%2Ffile.lisp;h=01da23bff2caa94319bb274eef14c05af7dbda34;hb=d8e0a653d6974279581a3d1a151bde02ea6023c9;hp=7b71b9dcbd19be84fa2f5830c70517910fcaabca;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/contrib/sb-simple-streams/file.lisp b/contrib/sb-simple-streams/file.lisp index 7b71b9d..01da23b 100644 --- a/contrib/sb-simple-streams/file.lisp +++ b/contrib/sb-simple-streams/file.lisp @@ -80,7 +80,8 @@ (format *terminal-io* "~&;;; ** closed ~S (fd ~D)~%" namestring fd) (when original - (revert-file namestring original)))) + (revert-file namestring original))) + :dont-save t) stream))))))) (defmethod device-open ((stream file-simple-stream) options) @@ -115,8 +116,8 @@ ;;; TODO: use this in src/code/fd-stream.lisp:fd-stream-misc-routine ;;; as well, snarf error reporting from there. (defun revert-file (filename original) - (declare (type simple-base-string filename) - (type (or simple-base-string null) original)) + (declare (type simple-string filename) + (type (or simple-string null) original)) ;; 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. @@ -140,8 +141,8 @@ ;;; TODO: use this in src/code/fd-stream.lisp:fd-stream-misc-routine ;;; as well, snarf error reporting from there. (defun delete-original (filename original) - (declare (type simple-base-string filename) - (type (or simple-base-string null) original)) + (declare (type simple-string filename) + (type (or simple-string null) original)) (when original (multiple-value-bind (okay err) (sb-unix:unix-unlink original) (unless okay @@ -244,7 +245,8 @@ (sb-ext:finalize stream (lambda () (sb-posix:munmap buffer size) - (format *terminal-io* "~&;;; ** unmapped ~S" buffer)))))) + (format *terminal-io* "~&;;; ** unmapped ~S" buffer)) + :dont-save t)))) stream))) @@ -267,6 +269,6 @@ (let ((pathname (getf options :filename))) (with-stream-class (probe-simple-stream stream) (add-stream-instance-flags stream :simple) - (when (sb-unix:unix-access (sb-int:unix-namestring pathname nil) sb-unix:f_ok) + (when (sb-unix:unix-access (file-namestring pathname) sb-unix:f_ok) (setf (sm pathname stream) pathname) t))))