X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fwin32-pathname.lisp;h=a3770feab832b04168a32928fab1aeeac0e72c6b;hb=8eee0d3a30bf39d9f201acff28c92059fe6c3e4e;hp=f904d6e96e61fd2f26f95706f6011044274f60a6;hpb=2529c316d05494f2bcdeccf98c3a6298ecd08d7d;p=sbcl.git diff --git a/src/code/win32-pathname.lisp b/src/code/win32-pathname.lisp index f904d6e..a3770fe 100644 --- a/src/code/win32-pathname.lisp +++ b/src/code/win32-pathname.lisp @@ -261,7 +261,9 @@ (unparse-win32-file pathname))) (defun unparse-native-win32-namestring (pathname as-file) - (declare (type pathname pathname)) + (declare (type pathname pathname) + ;; Windows doesn't like directory names with trailing slashes. + (ignore as-file)) (let* ((device (pathname-device pathname)) (directory (pathname-directory pathname)) (name (pathname-name pathname)) @@ -270,17 +272,16 @@ (type (pathname-type pathname)) (type-present-p (typep type '(not (member nil :unspecific)))) (type-string (if type-present-p type ""))) - (when name-present-p - (setf as-file nil)) (coerce (with-output-to-string (s) (when device (write-string device s) (write-char #\: s)) (tagbody - (ecase (pop directory) - (:absolute (write-char #\\ s)) - (:relative)) + (when directory + (ecase (pop directory) + (:absolute (write-char #\\ s)) + (:relative))) (unless directory (go :done)) :subdir (let ((piece (pop directory))) @@ -289,7 +290,7 @@ (string (write-string piece s)) (t (error "ungood directory segment in NATIVE-NAMESTRING: ~S" piece))) - (when (or directory (not as-file)) + (when (or directory name) (write-char #\\ s))) (when directory (go :subdir))