From 30708f20d21fd4e6cb0e5f76b83c734a60732b35 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 22 Aug 2005 20:29:19 +0000 Subject: [PATCH] Add a restart to ENSURE-DIRECTORIES-EXIST to retry directory creation. From Eduardo Munoz, cmucl-imp, 2005/07/31. --- code/filesys.lisp | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/code/filesys.lisp b/code/filesys.lisp index a341c6c8c..81638184d 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.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." :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 'simple-file-error - :pathname pathspec - :format-control "Can't create directory ~A." - :format-arguments (list namestring))) - (setf created-p t))))) + (tagbody + retry + (restart-case + (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 'simple-file-error + :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. (return (values pathname created-p)))))) -- GitLab