X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-simple-streams%2Ffile.lisp;h=5602b28a25cf45f83c674ed87c17e428c2e23825;hb=2fb9cd4a2286b82e065d6c673d91e46bd7f2194d;hp=e668269e781fdd0deb076985c5fb79450a56b6c5;hpb=f179b4c117ffc1886cf106c053b248ad3f88a968;p=sbcl.git diff --git a/contrib/sb-simple-streams/file.lisp b/contrib/sb-simple-streams/file.lisp index e668269..5602b28 100644 --- a/contrib/sb-simple-streams/file.lisp +++ b/contrib/sb-simple-streams/file.lisp @@ -152,15 +152,18 @@ (defmethod device-close ((stream file-simple-stream) abort) (with-stream-class (file-simple-stream stream) - (let ((fd (or (sm input-handle stream) (sm output-handle stream)))) - (when (sb-int:fixnump fd) + (let ((fd (or (sm input-handle stream) (sm output-handle stream))) + (closed nil)) + (when (integerp fd) (cond (abort (when (any-stream-instance-flags stream :output) + #+win32 (progn (sb-unix:unix-close fd) (setf closed t)) (revert-file (sm filename stream) (sm original stream)))) (t (when (sm delete-original stream) (delete-original (sm filename stream) (sm original stream))))) - (sb-unix:unix-close fd)) + (unless closed + (sb-unix:unix-close fd))) (when (sm buffer stream) (free-buffer (sm buffer stream)) (setf (sm buffer stream) nil)))) @@ -169,7 +172,7 @@ (defmethod device-file-position ((stream file-simple-stream)) (with-stream-class (file-simple-stream stream) (let ((fd (or (sm input-handle stream) (sm output-handle stream)))) - (if (sb-int:fixnump fd) + (if (integerp fd) (values (sb-unix:unix-lseek fd 0 sb-unix:l_incr)) (file-position fd))))) @@ -177,7 +180,7 @@ (declare (type fixnum value)) (with-stream-class (file-simple-stream stream) (let ((fd (or (sm input-handle stream) (sm output-handle stream)))) - (if (sb-int:fixnump fd) + (if (integerp fd) (values (sb-unix:unix-lseek fd (if (minusp value) (1+ value) value) (if (minusp value) sb-unix:l_xtnd sb-unix:l_set))) @@ -186,7 +189,7 @@ (defmethod device-file-length ((stream file-simple-stream)) (with-stream-class (file-simple-stream stream) (let ((fd (or (sm input-handle stream) (sm output-handle stream)))) - (if (sb-int:fixnump fd) + (if (integerp fd) (multiple-value-bind (okay dev ino mode nlink uid gid rdev size) (sb-unix:unix-fstat (sm input-handle stream)) (declare (ignore dev ino mode nlink uid gid rdev)) @@ -201,7 +204,7 @@ (prot (logior (if input sb-posix::PROT-READ 0) (if output sb-posix::PROT-WRITE 0))) (fd (or (sm input-handle stream) (sm output-handle stream)))) - (unless (sb-int:fixnump fd) + (unless (integerp fd) (error "Can't memory-map an encapsulated stream.")) (multiple-value-bind (okay dev ino mode nlink uid gid rdev size) (sb-unix:unix-fstat fd) @@ -282,6 +285,6 @@ (let ((pathname (getf options :filename))) (with-stream-class (probe-simple-stream stream) (add-stream-instance-flags stream :simple) - (when (sb-unix:unix-access (file-namestring pathname) sb-unix:f_ok) + (when (sb-unix:unix-access (%file-namestring pathname) sb-unix:f_ok) (setf (sm pathname stream) pathname) t))))