ensure-directory-exists: didn't work when *d-p-d* had NAME or TYPE components.

(let ((*default-pathname-defaults* #p"/tmp/foo"))
     (ensure-directories-exist "/"))
signalled an error that "/" doesn't exist because it was checking for "/foo".

diff --git a/NEWS b/NEWS
index 9d70697..a4137d0 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,5 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
-changes relative to sbcl-1.0.55:
+changes relative to sbcl-1.0.56:
   * enhancement: GENCGC reclaims space more aggressively when objects being
     allocated are a large fraction of the total available heap space.
     (lp#936304)
@@ -11,6 +11,8 @@ changes relative to sbcl-1.0.55:
     classoid even if X was not the proper name of the class. (lp#941102)
   * bug fix: declaration leakage between lexical environments due to careless
     use of NCONC in MAKE-LEXENV. (lp#924276)
+  * bug fix: ENSURE-DIRECTORIES-EXIST now works when *default-pathname-defaults*
+    contains NAME or TYPE components.
   * documentation:
     ** improved docstrings: REPLACE (lp#965592)
 

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 4543713..b14adc8 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -1136,7 +1136,11 @@ Experimental: interface subject to change."
       (error 'simple-file-error
              :format-control "bad place for a wild pathname"
              :pathname pathspec))
-    (let ((dir (pathname-directory pathname)))
+    (let* ((dir (pathname-directory pathname))
+           ;; *d-p-d* can have name and type components which would prevent
+           ;; PROBE-FILE below from working
+           (*default-pathname-defaults*
+             (make-pathname :directory dir :device (pathname-device pathname))))
       (loop for i from 1 upto (length dir)
             do
             (let* ((newpath (make-pathname

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 1c705a8..732f9d8 100644 (file)
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -592,4 +592,8 @@
   ;; * / :WILD
   (assert (equal (pathname-directory #p"\\*/") '(:relative "*"))))
 
+(with-test (:name :ensure-directories-exist-with-odd-d-p-d)
+  (let ((*default-pathname-defaults* #p"/tmp/foo"))
+    (ensure-directories-exist "/")))
+
 ;;;; success