From c6b35dc77f5b54857ffddf8f4a2b9493d7e8170f Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 13 Oct 2003 11:57:54 +0000 Subject: [PATCH] 0.8.4.21: A couple of filesystem-related fixes from Milan Zamazal ... :IF-EXISTS OPEN behaviour corrected ... don't error if a file is deleted from under us in DIRECTORY --- NEWS | 2 ++ src/code/fd-stream.lisp | 2 +- src/code/filesys.lisp | 13 ++++++++++--- tests/stream.impure.lisp | 10 ++++++++++ version.lisp-expr | 2 +- 5 files changed, 24 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index eea00876c..f5654b96c 100644 --- a/NEWS +++ b/NEWS @@ -2122,6 +2122,8 @@ changes in sbcl-0.8.5 relative to sbcl-0.8.4: * bug fix: obviously wrong type specifiers such as (FIXNUM 1) or (CHARACTER 10) are now reported as errors, rather than propagated as unknown types. (reported by piso on #lisp) + * bug fix: the :IF-EXISTS argument to OPEN now behaves correctly + with values NIL and :ERROR. (thanks to Milan Zamazal) * compiler enhancement: SIGNUM is now better able to derive the type of its result. * fixed some bugs revealed by Paul Dietz' test suite: diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index ce075166f..b403ffad1 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -1225,7 +1225,7 @@ (open-error "~@" pathname)) (t nil))) - ((and (eql errno sb!unix:eexist) if-exists) + ((and (eql errno sb!unix:eexist) (null if-exists)) nil) (t (vanilla-open-error))))))))) diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 46e9e8582..32a48ef84 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -829,9 +829,16 @@ (merged-pathname (merge-pathnames pathname))) (!enumerate-matches (match merged-pathname) (let* ((*ignore-wildcards* t) - (truename (truename match))) - (setf (gethash (namestring truename) truenames) - truename))) + ;; FIXME: Why not TRUENAME? As reported by Milan Zamazal + ;; sbcl-devel 2003-10-05, using TRUENAME causes a race + ;; condition whereby removal of a file during the + ;; directory operation causes an error. It's not clear + ;; what the right thing to do is, though. -- CSR, + ;; 2003-10-13 + (truename (probe-file match))) + (when truename + (setf (gethash (namestring truename) truenames) + truename)))) (mapcar #'cdr ;; Sorting isn't required by the ANSI spec, but sorting ;; into some canonical order seems good just on the diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp index d3f3adfa6..8b5649d04 100644 --- a/tests/stream.impure.lisp +++ b/tests/stream.impure.lisp @@ -66,5 +66,15 @@ (assert (= (read-byte s) -1))) (delete-file p)) +;;; :IF-EXISTS got :ERROR and NIL the wrong way round (reported by +;;; Milan Zamazal) +(let* ((p "this-file-will-exist") + (stream (open p :direction :output :if-exists :error))) + (assert (null (with-open-file (s p :direction :output :if-exists nil) s))) + (assert (raises-error? + (with-open-file (s p :direction :output :if-exists :error)))) + (close stream) + (delete-file p)) + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 9743a1387..6e2765f5e 100644 --- a/version.lisp-expr +++ b/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".) -"0.8.4.20" +"0.8.4.21"