1.0.29.6: work around stack-allocated value cell badness in HANDLER-CASE

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

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 825933b..9c8ac6b 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -2405,13 +2405,17 @@
         (:io     (values   t   t sb!unix:o_rdwr))
         (:probe  (values   t nil sb!unix:o_rdonly)))
     (declare (type index mask))
-    (let* ((pathname (merge-pathnames filename))
-           (namestring
-            (cond ((unix-namestring pathname input))
-                  ((and input (eq if-does-not-exist :create))
-                   (unix-namestring pathname nil))
-                  ((and (eq direction :io) (not if-does-not-exist-given))
-                   (unix-namestring pathname nil)))))
+    (let* (;; PATHNAME is the pathname we associate with the stream.
+           (pathname (merge-pathnames filename))
+           (physical (physicalize-pathname pathname))
+           (truename (probe-file physical))
+           ;; NAMESTRING is the native namestring we open the file with.
+           (namestring (cond (truename
+                              (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)))
+                              (native-namestring physical :as-file t)))))
       ;; Process if-exists argument if we are doing any output.
       (cond (output
              (unless if-exists-given
@@ -2476,7 +2480,7 @@
                           (when (and output (= (logand orig-mode #o170000)
                                                #o40000))
                             (error 'simple-file-error
-                                   :pathname namestring
+                                   :pathname pathname
                                    :format-control
                                    "can't open ~S for output: is a directory"
                                    :format-arguments (list namestring)))
@@ -2629,7 +2633,8 @@
       (cond (new-name
              (setf (fd-stream-pathname stream) new-name)
              (setf (fd-stream-file stream)
-                   (unix-namestring new-name nil))
+                   (native-namestring (physicalize-pathname new-name)
+                                      :as-file t))
              t)
             (t
              (fd-stream-pathname stream)))))