diff --git a/code/filesys.lisp b/code/filesys.lisp index f10c9dbae17fb476a5d8e10f71f8d6b03906996e..d8c1eefb0736ea6a3378870d9daebe9693c8a0a6 100644 --- a/code/filesys.lisp +++ b/code/filesys.lisp @@ -6,7 +6,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.44 1998/01/30 17:11:09 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.45 1998/02/11 18:15:22 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1179,21 +1179,25 @@ (pathname (if (logical-pathname-p pathname) (translate-logical-pathname pathname) pathname)) - (dir (pathname-directory pathname)) (created-p nil)) (when (wild-pathname-p pathname) (error (make-condition 'file-error :pathname pathspec))) - (loop for i from 1 upto (length dir) - do (let ((newpath (make-pathname :host (pathname-host pathname) - :device (pathname-device pathname) - :directory (subseq dir 0 i)))) - (unless (probe-file newpath) - (let ((namestring (namestring newpath))) - (when verbose - (format *standard-output* "~&Creating directory: ~A~%" - namestring)) - (unix:unix-mkdir namestring mode) - (unless (probe-file namestring) - (error (make-condition 'file-error :pathname pathspec))) - (setf created-p t))))) - (values pathname created-p))) + (enumerate-search-list (pathname pathname) + (let ((dir (pathname-directory pathname))) + (loop for i from 1 upto (length dir) + do (let ((newpath (make-pathname + :host (pathname-host pathname) + :device (pathname-device pathname) + :directory (subseq dir 0 i)))) + (unless (probe-file newpath) + (let ((namestring (namestring newpath))) + (when verbose + (format *standard-output* "~&Creating directory: ~A~%" + namestring)) + (unix:unix-mkdir namestring mode) + (unless (probe-file namestring) + (error (make-condition 'file-error + :pathname pathspec))) + (setf created-p t))))) + ;; Only the first path in a search-list is considered. + (return (values pathname created-p))))))