[armedbear-cvs] r13289 - trunk/abcl/src/org/armedbear/lisp

[mevenson at common-lisp.net]

Author: mevenson
Date: Tue May 24 02:01:03 2011
New Revision: 13289

Log:
Fix ENSURE-DIRECTORIES-EXIST by loosening wild pathname restrictions.

CLHS: Function ENSURE-DIRECTORIES-EXIST "An error of type file-error
is signaled if the host, device, or directory part of pathspec is
wild."

Modified:
   trunk/abcl/src/org/armedbear/lisp/ensure-directories-exist.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/ensure-directories-exist.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ensure-directories-exist.lisp	Mon May 23 09:27:17 2011	(r13288)
+++ trunk/abcl/src/org/armedbear/lisp/ensure-directories-exist.lisp	Tue May 24 02:01:03 2011	(r13289)
@@ -36,9 +36,14 @@
 (defun ensure-directories-exist (pathspec &key verbose)
   (let ((pathname (pathname pathspec))
 	(created-p nil))
-    (when (wild-pathname-p pathname)
+;;; CLHS: Function ENSURE-DIRECTORIES-EXIST "An error of type
+;;; file-error is signaled if the host, device, or directory part of
+;;; pathspec is wild."
+    (when (or (wild-pathname-p pathname :host)
+              (wild-pathname-p pathname :device)
+              (wild-pathname-p pathname :directory))
       (error 'file-error
-	     :format-control "Bad place for a wild pathname."
+	     :format-control "Bad place for a wild HOST, DEVICE, or DIRECTORY component."
 	     :pathname pathname))
     (let ((dir (pathname-directory pathname)))
       (loop for i from 1 upto (length dir)