Changeset 14152


Ignore:
Timestamp:
09/14/12 22:09:14 (8 years ago)
Author:
Mark Evenson
Message:

ENSURE-DIRECTORIES-EXIST should be operating on Pathnames not namestrings.

More informative error message when creating a directory fails.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/ensure-directories-exist.lisp

    r13289 r14152  
    3434(in-package "SYSTEM")
    3535
    36 (defun ensure-directories-exist (pathspec &key verbose)
     36(defun ensure-directories-exist (pathspec &key (verbose t)) ;; DEBUG
    3737  (let ((pathname (pathname pathspec))
    3838  (created-p nil))
     
    4747       :pathname pathname))
    4848    (let ((dir (pathname-directory pathname)))
    49       (loop for i from 1 upto (length dir)
    50         do (let ((newpath (make-pathname
    51                            :host (pathname-host pathname)
    52                            :device (pathname-device pathname)
    53                            :directory (subseq dir 0 i))))
    54              (unless (probe-file newpath)
    55                (let ((namestring (namestring newpath)))
    56                  (when verbose
    57                    (fresh-line)
    58                    (format *standard-output*
    59                            "Creating directory: ~A~%"
    60                            namestring))
    61                  (mkdir namestring)
    62                  (unless (probe-file namestring)
    63                    (error 'file-error
    64                           :pathname pathspec
    65                           :format-control "Can't create directory ~A."
    66                           :format-arguments (list namestring)))
     49      (loop :for i :from 1 :upto (length dir)
     50         :doing (let ((newpath (make-pathname
     51                                :host (pathname-host pathname)
     52                                :device (if (pathname-device pathname)
     53                                            (pathname-device pathname)
     54                                            :unspecific)
     55                                :directory (subseq dir 0 i))))
     56                  (unless (probe-directory newpath)
     57                    (when verbose
     58                      (fresh-line)
     59                      (format *standard-output*
     60                              "Creating directory of pathname ~A.~&"
     61                              newpath))
     62                    (mkdir newpath)
     63                    (unless (probe-directory newpath)
     64                      (error 'file-error
     65                             :pathname newpath
     66                             :format-control "Can't ensure directory~& ~S ~&ancestor of~&  ~S."
     67                             :format-arguments (list newpath pathname)))
    6768                 (setq created-p t)))))
    68       (values pathname created-p))))
     69      (values pathname created-p)))
Note: See TracChangeset for help on using the changeset viewer.