From: Paul Khuong Date: Thu, 14 Nov 2013 20:15:38 +0000 (-0500) Subject: More meaningful error message for OPEN :IF-EXISTS :NEW-VERSION X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1c0ce8a24b12334a9eb7908ad72d329394d537c7;p=sbcl.git More meaningful error message for OPEN :IF-EXISTS :NEW-VERSION We don't try to simulate versioned filesystems on top of standard UNIX operations, because that would be lossy. Now explained more explicitly. Based on a patch by Philip Munksgaard, fixes lp#455381. --- diff --git a/NEWS b/NEWS index c9f52c7..bda318e 100644 --- a/NEWS +++ b/NEWS @@ -21,6 +21,9 @@ changes relative to sbcl-1.1.13: than a single word. * bug fix: contribs couldn't be built on Windows with MinGW. * bug fix: Better pathname handling on Windows. (lp#922117) + * bug fix: OPEN reports a more meaningful error when an existing file is + opened for output with :if-exists :new-version. Thanks to Philip + Munksgaard. (lp#455381) changes in sbcl-1.1.13 relative to sbcl-1.1.12: * optimization: better distribution of SXHASH over small conses of related diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index cae969d..acf84b0 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -2370,7 +2370,12 @@ (ensure-one-of if-does-not-exist '(:error :create nil) :if-does-not-exist) - (cond ((eq if-does-not-exist :create) + (cond ((and if-exists-given + truename + (eq if-exists :new-version)) + (open-error "OPEN :IF-EXISTS :NEW-VERSION is not supported ~ + when a new version must be created.")) + ((eq if-does-not-exist :create) (setf mask (logior mask sb!unix:o_creat))) ((not (member if-exists '(:error nil)))) ;; Both if-does-not-exist and if-exists now imply diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp index 0dc72a7..00382ab 100644 --- a/tests/filesys.pure.lisp +++ b/tests/filesys.pure.lisp @@ -239,3 +239,14 @@ (assert (not (do-open t nil nil :io))) (assert (raises-error? (do-open t :error :error :io))))) + +(with-test (:name :open-new-version) + (multiple-value-bind (value error) + (ignore-errors (open #.(or *compile-file-truename* *load-truename*) + :direction :output + :if-exists :new-version)) + (assert (not value)) + (assert error) + (assert (equal (simple-condition-format-control error) + "OPEN :IF-EXISTS :NEW-VERSION is not supported ~ + when a new version must be created."))))