Skip to content
Snippets Groups Projects
Commit 30708f20 authored by rtoy's avatar rtoy
Browse files

Add a restart to ENSURE-DIRECTORIES-EXIST to retry directory

creation.  From Eduardo Munoz, cmucl-imp, 2005/07/31.
parent 950d9f01
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.86 2005/02/10 15:57:08 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.87 2005/08/22 20:29:19 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1328,17 +1328,22 @@ optionally keeping some of the most recent old versions." ...@@ -1328,17 +1328,22 @@ optionally keeping some of the most recent old versions."
:host (pathname-host pathname) :host (pathname-host pathname)
:device (pathname-device pathname) :device (pathname-device pathname)
:directory (subseq dir 0 i)))) :directory (subseq dir 0 i))))
(unless (probe-file newpath) (tagbody
(let ((namestring (namestring newpath))) retry
(when verbose (restart-case
(format *standard-output* "~&Creating directory: ~A~%" (unless (probe-file newpath)
namestring)) (let ((namestring (namestring newpath)))
(unix:unix-mkdir namestring mode) (when verbose
(unless (probe-file namestring) (format *standard-output* "~&Creating directory: ~A~%"
(error 'simple-file-error namestring))
:pathname pathspec (unix:unix-mkdir namestring mode)
:format-control "Can't create directory ~A." (unless (probe-file namestring)
:format-arguments (list namestring))) (error 'simple-file-error
(setf created-p t))))) :pathname pathspec
:format-control "Can't create directory ~A."
:format-arguments (list namestring)))
(setf created-p t)))
(retry () :report "Try to create the directory again"
(go retry))))))
;; Only the first path in a search-list is considered. ;; Only the first path in a search-list is considered.
(return (values pathname created-p)))))) (return (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