From d69f24617290c4a875ff2356ca229bf1659feafe Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Fri, 23 Oct 2020 22:44:36 +0200
Subject: [PATCH] mkdir: Add an optional argument, recursive, to create the
intermediates
2020-10-23 divoplade <d@divoplade.fr>
* 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(-)
@@ -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
@@ -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
@@ -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;
@@ -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);
@@ -2020,6 +2020,46 @@
(not (string-index (%search-load-path (basename (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 dir #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 dir #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))))
+
(delete-file (test-file))
;;; Local Variables:
--
2.28.0