From: Paul Khuong <pvk@pvk.ca>
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."))))