From 6b6920e05b2afefc3729bd60760c26d2476f5c82 Mon Sep 17 00:00:00 2001 From: divoplade Date: Fri, 23 Oct 2020 22:44:36 +0200 Subject: [PATCH 1/2] mkdir: Add an optional argument, recursive, to create the intermediates 2020-10-23 divoplade * libguile/filesys.c: include eq.h, so we can compare strings. * libguile/filesys.c (scm_mkdir): add an optional argument, recursive, to create the intermediate directories if they do not exist. * libguile/filesys.h (scm_mkdir): add the optional argument to the prototype. * doc/ref/posix.texi (mkdir): document the new optional argument. * NEWS: say there is a new argument. * test-suite/tests/ports.test: add a test suite to check recursive mkdir. --- NEWS | 5 +++++ doc/ref/posix.texi | 7 +++++-- libguile/filesys.c | 39 ++++++++++++++++++++++++++++++++++-- libguile/filesys.h | 2 +- test-suite/tests/ports.test | 40 +++++++++++++++++++++++++++++++++++++ 5 files changed, 88 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 694449202..765f3d2a3 100644 --- a/NEWS +++ b/NEWS @@ -16,6 +16,11 @@ O(1) dispatch time, regardless of the length of the chain. This optimization is also unlocked in many cases for `match' expressions with many similar clauses whose first differentiator are constants. +** Additional optional argument in `mkdir' to create the directory recursively + +When the third argument to mkdir is true, the intermediate directories +are created. + * Incompatible changes ** `copy' read-option removed diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index f34c5222d..db0cdeae0 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -878,12 +878,15 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to) @var{oldpath}. The return value is unspecified. @end deffn -@deffn {Scheme Procedure} mkdir path [mode] -@deffnx {C Function} scm_mkdir (path, mode) +@deffn {Scheme Procedure} mkdir path [mode [recursive]] +@deffnx {C Function} scm_mkdir (path, mode, recursive) Create a new directory named by @var{path}. If @var{mode} is omitted then the permissions of the directory are set to @code{#o777} masked with the current umask (@pxref{Processes, @code{umask}}). Otherwise they are set to the value specified with @var{mode}. +If @var{recursive} is true, also try to create the intermediate missing +directories. If an error happens, the created directories are left in +place. The return value is unspecified. @end deffn diff --git a/libguile/filesys.c b/libguile/filesys.c index 39bfd38cc..a3c26cfe0 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -82,6 +82,7 @@ #include "async.h" #include "boolean.h" #include "dynwind.h" +#include "eq.h" #include "fdes-finalizers.h" #include "feature.h" #include "fports.h" @@ -1271,12 +1272,15 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0, #undef FUNC_NAME #endif /* HAVE_GETCWD */ -SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0, - (SCM path, SCM mode), +SCM_DEFINE (scm_mkdir, "mkdir", 1, 2, 0, + (SCM path, SCM mode, SCM recursive), "Create a new directory named by @var{path}. If @var{mode} is omitted\n" "then the permissions of the directory are set to @code{#o777}\n" "masked with the current umask (@pxref{Processes, @code{umask}}).\n" "Otherwise they are set to the value specified with @var{mode}.\n" + "If @var{recursive} is true, also try tocreate the intermediate missing\n" + "directories. If an error happens, the created directories are left\n" + "in place.\n" "The return value is unspecified.") #define FUNC_NAME s_scm_mkdir { @@ -1285,6 +1289,37 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0, c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode); + if (scm_is_true (recursive)) + { + /* Record in paths all intermediate directory names up to the + root. The root is reached when the dirname of the current + directory is equal to the directory. */ + SCM paths = SCM_EOL; + SCM current_name = path; + SCM parent_name = scm_dirname (current_name); + while (!scm_is_true (scm_equal_p (parent_name, current_name))) + { + paths = scm_cons (parent_name, paths); + current_name = parent_name; + parent_name = scm_dirname (current_name); + } + if (scm_is_true (scm_equal_p (current_name, scm_from_utf8_string (".")))) + { + /* If the root is '.', then also make the current working + directory the same way. */ + scm_mkdir (scm_getcwd (), mode, recursive); + } + while (!scm_is_null (paths)) + { + SCM dir = scm_car (paths); + /* Ignore the errors. If one mkdir fails, the final + STRING_SYSCALL at the end of this function will fail + too. */ + STRING_SYSCALL (dir, c_dir, mkdir (c_dir, c_mode)); + paths = scm_cdr (paths); + } + } + STRING_SYSCALL (path, c_path, rv = mkdir (c_path, c_mode)); if (rv != 0) SCM_SYSERROR; diff --git a/libguile/filesys.h b/libguile/filesys.h index f870ee434..011cc5d1d 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -49,7 +49,7 @@ SCM_API SCM scm_stat (SCM object, SCM exception_on_error); SCM_API SCM scm_link (SCM oldpath, SCM newpath); SCM_API SCM scm_rename (SCM oldname, SCM newname); SCM_API SCM scm_delete_file (SCM str); -SCM_API SCM scm_mkdir (SCM path, SCM mode); +SCM_API SCM scm_mkdir (SCM path, SCM mode, SCM recursive); SCM_API SCM scm_rmdir (SCM path); SCM_API SCM scm_directory_stream_p (SCM obj); SCM_API SCM scm_opendir (SCM dirname); diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 31fb2b0a8..4a247240e 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -2022,6 +2022,46 @@ (delete-file (test-file)) +(with-test-prefix "recursive mkdir" + + (pass-if "Relative recursive mkdir creates the chain of directories" + (let ((dir "./nested/relative/subdirectory")) + (mkdir dir #o777 #t) + (let ((ok + (catch #t + (lambda () + (with-output-to-file "./nested/relative/subdirectory/file" + (lambda () + (display "The directories have been created!") + #t))) + (lambda (error . args) + #f)))) + (when ok + (delete-file "./nested/relative/subdirectory/file") + (rmdir "./nested/relative/subdirectory") + (rmdir "./nested/relative") + (rmdir "./nested")) + ok))) + + (pass-if "Absolute recursive mkdir creates the chain of directories" + (let ((dir (string-append %temporary-directory "/nested/absolute/subdirectory"))) + (mkdir dir #o777 #t) + (let ((ok + (catch #t + (lambda () + (with-output-to-file (string-append dir "/file") + (lambda () + (display "The directories have been created!") + #t))) + (lambda (error . args) + #f)))) + (when ok + (delete-file (string-append dir "/file")) + (rmdir (string-append %temporary-directory "/nested/absolute/subdirectory")) + (rmdir (string-append %temporary-directory "/nested/absolute")) + (rmdir (string-append %temporary-directory "/nested"))) + ok)))) + ;;; Local Variables: ;;; eval: (put 'test-decoding-error 'scheme-indent-function 3) ;;; eval: (put 'with-load-path 'scheme-indent-function 1) -- 2.28.0