Skip to content
Snippets Groups Projects
Commit 6cb10a66 authored by dtc's avatar dtc
Browse files

Few fixes to ensure-directories-exist: make it work with logical

pathnames; don't call truename on the pathname as this will likely
fail if it's a file.
parent 07825d9c
No related branches found
No related tags found
No related merge requests found
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.42 1997/05/16 11:45:15 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.43 1997/05/16 17:03:56 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1172,23 +1172,25 @@ ...@@ -1172,23 +1172,25 @@
;;; Ensure-Directories-Exist -- Public ;;; Ensure-Directories-Exist -- Public
;;; ;;;
(defun ensure-directories-exist (pathspec &key verbose (mode #o777)) (defun ensure-directories-exist (pathspec &key verbose (mode #o777))
(let ((dir (pathname-directory pathspec)) (let* ((pathname (pathname pathspec))
(created-p nil)) (pathname (if (logical-pathname-p pathname)
(when (wild-pathname-p (make-pathname :host (pathname-host pathspec) (translate-logical-pathname pathname)
:device (pathname-device pathspec) pathname))
:directory (pathname-directory pathspec))) (dir (pathname-directory pathname))
(created-p nil))
(when (wild-pathname-p pathname)
(error (make-condition 'file-error :pathname pathspec))) (error (make-condition 'file-error :pathname pathspec)))
(loop for i from 1 upto (length dir) (loop for i from 1 upto (length dir)
do (let ((newpath (make-pathname :host (pathname-host pathspec) do (let ((newpath (make-pathname :host (pathname-host pathname)
:device (pathname-device pathspec) :device (pathname-device pathname)
:directory (subseq dir 0 i)))) :directory (subseq dir 0 i))))
(unless (probe-file newpath) (unless (probe-file newpath)
(let ((namestring (namestring newpath))) (let ((namestring (namestring newpath)))
(when verbose (when verbose
(format *standard-output* "~&Creating directory: ~A~%" (format *standard-output* "~&Creating directory: ~A~%"
namestring)) namestring))
(unix:unix-mkdir namestring mode) (unix:unix-mkdir namestring mode)
(unless (probe-file namestring) (unless (probe-file namestring)
(error (make-condition 'file-error :pathname pathspec))) (error (make-condition 'file-error :pathname pathspec)))
(setf created-p t))))) (setf created-p t)))))
(values (truename pathspec) created-p))) (values pathname created-p)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment