From 273bfe7510da8ab740e65df11b72d9bb801885f3 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 16 Nov 2021 11:06:24 +0000 Subject: =?UTF-8?q?Allow=20file=20ports=20in=20=E2=80=98chdir=E2=80=99=20w?= =?UTF-8?q?hen=20supported.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * configure.ac: Check for ‘fchdir’. * libguile/filesys.c (scm_chdir): Support file ports. (scm_init_filesys): Report support of file ports. * doc/ref/posix.texi (Processes): Update accordingly. * doc/ref/guile.texi: Add copyright line for new documentation in this patch and later patches. * test-suite/tests/filesys.test ("chdir"): Test it. Signed-off-by: Ludovic Courtès --- libguile/filesys.c | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) (limited to 'libguile') diff --git a/libguile/filesys.c b/libguile/filesys.c index 7f8377815..43e55beb4 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1,5 +1,6 @@ /* Copyright 1996-2002,2004,2006,2009-2019,2021 Free Software Foundation, Inc. + Copyright 2021 Maxime Devos This file is part of Guile. @@ -608,12 +609,28 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0, SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0, (SCM str), "Change the current working directory to @var{str}.\n" + "@var{str} can be a string containing a file name,\n" + "or a port if supported by the system.\n" + "@code{(provided? 'chdir-port)} reports whether ports " + "are supported." "The return value is unspecified.") #define FUNC_NAME s_scm_chdir { int ans; - STRING_SYSCALL (str, c_str, ans = chdir (c_str)); +#ifdef HAVE_FCHDIR + if (SCM_OPFPORTP (str)) + { + int fdes; + fdes = SCM_FPORT_FDES (str); + SCM_SYSCALL (ans = fchdir (fdes)); + scm_remember_upto_here_1 (str); + } + else +#endif + { + STRING_SYSCALL (str, c_str, ans = chdir (c_str)); + } if (ans != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; @@ -2053,5 +2070,9 @@ scm_init_filesys () scm_dot_string = scm_from_utf8_string ("."); +#ifdef HAVE_FCHDIR + scm_add_feature("chdir-port"); +#endif + #include "filesys.x" } -- cgit v1.2.1