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 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(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 @@
;;; Ensure-Directories-Exist -- Public
;;;
(defun ensure-directories-exist (pathspec &key verbose (mode #o777))
(let ((dir (pathname-directory pathspec))
(created-p nil))
(when (wild-pathname-p (make-pathname :host (pathname-host pathspec)
:device (pathname-device pathspec)
:directory (pathname-directory pathspec)))
(let* ((pathname (pathname pathspec))
(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 pathspec)
:device (pathname-device pathspec)
: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 (truename pathspec) created-p)))
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)))
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