More meaningful error message for OPEN :IF-EXISTS :NEW-VERSION

[sbcl.git] / src / code / fd-stream.lisp

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index c583f17..acf84b0 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -2325,7 +2325,8 @@
                               (native-namestring truename :as-file t))
                              ((or (not input)
                                   (and input (eq if-does-not-exist :create))
-                                  (and (eq direction :io) (not if-does-not-exist-given)))
+                                  (and (eq direction :io)
+                                       (not if-does-not-exist-given)))
                               (native-namestring physical :as-file t)))))
       (flet ((open-error (format-control &rest format-arguments)
                (error 'simple-file-error
@@ -2369,9 +2370,14 @@
         (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 '(:new-version :error nil))))
+              ((not (member if-exists '(:error nil))))
               ;; Both if-does-not-exist and if-exists now imply
               ;; that there will be no opening of files, and either
               ;; an error would be signalled, or NIL returned
@@ -2381,7 +2387,7 @@
                (open-error "OPEN :IF-DOES-NOT-EXIST ~s ~
                                  :IF-EXISTS ~s will always signal an error."
                            if-does-not-exist if-exists))
-              ((sb!unix:unix-stat namestring)
+              (truename
                (if if-exists
                    (open-error "File exists ~s." pathname)
                    (return-from open)))