From 8093c3685a97f556a752fed1115f896d4cd9b13e Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Fri, 13 Apr 2012 15:19:20 +0400 Subject: [PATCH] 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". --- NEWS | 4 +++- src/code/filesys.lisp | 6 +++++- tests/pathnames.impure.lisp | 4 ++++ 3 files changed, 12 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 9d70697..a4137d0 100644 --- 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 --- 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 --- 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 -- 1.7.10.4