From: divoplade <d@divoplade.fr>
To: 44186@debbugs.gnu.org
Cc: 44130@debbugs.gnu.org, zimoun <zimon.toutoune@gmail.com>
Subject: bug#44186: Recursive mkdir
Date: Sat, 24 Oct 2020 00:00:08 +0200 [thread overview]
Message-ID: <21802e695ea4472c8aba0a686e6bf025890c64d6.camel@divoplade.fr> (raw)
In-Reply-To: <86sga420pw.fsf@gmail.com>
[-- Attachment #1: Type: text/plain, Size: 891 bytes --]
Dear guile,
I have slightly modified the mkdir function so that it takes a third
argument to try to create the intermediate directories when calling
mkdir, in effect acting as "mkdir -p".
However, I could not make the test suite run the ports test, on which I
added the test for the new behavior. Is it expected? How do I run it?
In the mean time, here is the WIP version of the patch.
Best regards,
divoplade
Le vendredi 23 octobre 2020 à 21:36 +0200, zimoun a écrit :
> salut,
>
> On Thu, 22 Oct 2020 at 01:29, divoplade <d@divoplade.fr> wrote:
>
> > 1. Lobby guile to provide this function out of the box (this will
> > take
> > time);
>
> This path seems the one to go. It will take less time than running
> Guile on Windows. ;-)
>
> The only issue is that your code will depend on Guile 3.0.x where
> x>4.
>
> Otherwise, why is it not possible to send a patch to Guile?
[-- Attachment #2: 0001-mkdir-Add-an-optional-argument-recursive-to-create-t.patch --]
[-- Type: text/x-patch, Size: 7683 bytes --]
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(-)
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..c2b8b0596 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -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
next parent reply other threads:[~2020-10-23 22:00 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <6ff632f5c1e378647cecc7177b7018fb8a0ee6d4.camel@divoplade.fr>
[not found] ` <86sga420pw.fsf@gmail.com>
2020-10-23 22:00 ` divoplade [this message]
2020-10-23 22:07 ` bug#44186: Recursive mkdir zimoun
2020-10-23 23:32 ` Bengt Richter
2020-10-24 6:17 ` divoplade
2020-10-25 4:13 ` Bengt Richter
2020-10-25 7:45 ` Ricardo Wurmus
2020-10-25 9:07 ` divoplade
2020-10-25 10:44 ` divoplade
[not found] ` <handler.44186.B.16034904223692.ack@debbugs.gnu.org>
2020-10-23 22:46 ` divoplade
2020-10-26 21:05 ` Leo Prikler
2020-10-27 7:01 ` divoplade
2020-10-27 9:19 ` Leo Prikler
2020-10-27 10:21 ` divoplade
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=21802e695ea4472c8aba0a686e6bf025890c64d6.camel@divoplade.fr \
--to=d@divoplade.fr \
--cc=44130@debbugs.gnu.org \
--cc=44186@debbugs.gnu.org \
--cc=zimon.toutoune@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).