From c6fd5a650d63d358b182777ace8c42c8684f6f9b Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 2 Jun 2009 15:59:33 +0000 Subject: [PATCH] 1.0.28.72: two regressions from 1.0.28.59 * OPEN should not physicalize the pathname associated with the stream. * RENAME-FILE needs to deal with logical pathnames. (Both revealed by ansi-tests, as were the last bunch.) --- src/code/fd-stream.lisp | 11 +++++++---- src/code/filesys.lisp | 3 ++- version.lisp-expr | 2 +- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 7ca75d8..9c8ac6b 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -2405,14 +2405,17 @@ (:io (values t t sb!unix:o_rdwr)) (:probe (values t nil sb!unix:o_rdonly))) (declare (type index mask)) - (let* ((pathname (physicalize-pathname (merge-pathnames filename))) - (truename (probe-file pathname)) + (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 pathname :as-file t))))) + (native-namestring physical :as-file t))))) ;; Process if-exists argument if we are doing any output. (cond (output (unless if-exists-given @@ -2477,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))) diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index aba52a6..cfd654c 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -450,7 +450,8 @@ or if PATHSPEC is a wild pathname." (let* ((original (truename file)) (original-namestring (native-namestring original :as-file t)) (new-name (merge-pathnames new-name original)) - (new-namestring (native-namestring new-name :as-file t))) + (new-namestring (native-namestring (physicalize-pathname new-name) + :as-file t))) (unless new-namestring (error 'simple-file-error :pathname new-name diff --git a/version.lisp-expr b/version.lisp-expr index 1d56119..fe9eba3 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".) -"1.0.28.71" +"1.0.28.72" -- 1.7.10.4