From: Maxime Devos <maximedevos@telenet.be>
To: guile-devel@gnu.org
Cc: Maxime Devos <maximedevos@telenet.be>
Subject: [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported.
Date: Tue, 16 Nov 2021 11:06:24 +0000 [thread overview]
Message-ID: <20211116110637.125579-2-maximedevos@telenet.be> (raw)
In-Reply-To: <20211116110637.125579-1-maximedevos@telenet.be>
* 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.
---
configure.ac | 3 ++-
doc/ref/guile.texi | 3 ++-
doc/ref/posix.texi | 5 ++++-
libguile/filesys.c | 23 +++++++++++++++++++-
test-suite/tests/filesys.test | 41 +++++++++++++++++++++++++++++++++++
5 files changed, 71 insertions(+), 4 deletions(-)
diff --git a/configure.ac b/configure.ac
index bd49bf162..b7e4663f7 100644
--- a/configure.ac
+++ b/configure.ac
@@ -484,7 +484,8 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# sendfile - non-POSIX, found in glibc
#
AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
- fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid \
+ fesetround ftime ftruncate fchown fchmod fchdir \
+ getcwd geteuid getsid \
gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \
nice readlink rename rmdir setegid seteuid \
setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64 \
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index 660b1ae90..48af1f820 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -14,7 +14,8 @@
This manual documents Guile version @value{VERSION}.
Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software Foundation,
-Inc.
+Inc. \\
+Copyright (C) 2021 Maxime Devos
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 7633bd5a3..7555f9319 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -2,6 +2,7 @@
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
@c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017, 2021 Free Software Foundation, Inc.
+@c Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
@c See the file guile.texi for copying conditions.
@node POSIX
@@ -1605,7 +1606,9 @@ The return value is unspecified.
@deffn {Scheme Procedure} chdir str
@deffnx {C Function} scm_chdir (str)
@cindex current directory
-Change the current working directory to @var{str}.
+Change the current working directory to @var{str}. @var{str} can be a
+string containing a file name, or a port if supported by the system.
+@code{(provided? 'chdir-port)} reports whether ports are supported.
The return value is unspecified.
@end deffn
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 6247734e8..2a9c36a12 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 <maximedevos@telenet.be>
This file is part of Guile.
@@ -621,12 +622,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;
@@ -2066,5 +2083,9 @@ scm_init_filesys ()
scm_dot_string = scm_from_utf8_string (".");
+#ifdef HAVE_FCHDIR
+ scm_add_feature("chdir-port");
+#endif
+
#include "filesys.x"
}
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 6fed981e5..6b09a2ba0 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -1,6 +1,7 @@
;;;; filesys.test --- test file system functions -*- scheme -*-
;;;;
;;;; Copyright (C) 2004, 2006, 2013, 2019, 2021 Free Software Foundation, Inc.
+;;;; Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -265,3 +266,43 @@
(result (eqv? 'directory (stat:type _stat))))
(false-if-exception (rmdir name))
result)))))
+
+(with-test-prefix "chdir"
+ (pass-if-equal "current directory" (getcwd)
+ (begin (chdir ".") (getcwd)))
+ (define file (search-path %load-path "ice-9/boot-9.scm"))
+
+
+ (pass-if-equal "test directory" (dirname file)
+ (let ((olddir (getcwd))
+ (dir #f))
+ (chdir (dirname file))
+ (set! dir (getcwd))
+ (chdir olddir)
+ dir))
+
+ (pass-if-equal "test directory, via port" (dirname file)
+ (unless (provided? 'chdir-port)
+ (throw 'unresolved))
+ (let ((olddir (getcwd))
+ (port (open (dirname file) O_RDONLY))
+ (dir #f))
+ (chdir port)
+ (set! dir (getcwd))
+ (chdir olddir)
+ dir))
+
+ (pass-if-exception "closed port" exception:wrong-type-arg
+ (unless (provided? 'chdir-port)
+ (throw 'unresolved))
+ (let ((port (open (dirname file) O_RDONLY))
+ (olddir (getcwd)))
+ (close-port port)
+ (chdir port)
+ (chdir olddir))) ; should not be reached
+
+ (pass-if-exception "not a port or file name" exception:wrong-type-arg
+ (chdir '(stuff)))
+
+ (pass-if-exception "non-file port" exception:wrong-type-arg
+ (chdir (open-input-string ""))))
--
2.30.2
next prev parent reply other threads:[~2021-11-16 11:06 UTC|newest]
Thread overview: 26+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-03-12 21:59 [PATCH] Bindings to *at functions & allowing more functions to operate on ports Maxime Devos
2021-03-27 21:19 ` Maxime Devos
2021-03-28 11:17 ` tomas
2021-05-04 22:58 ` rob piko
2021-05-05 10:11 ` Maxime Devos
2021-11-16 11:06 ` [PATCH v2 00/14] Bindings to *at functions Maxime Devos
2021-11-16 11:06 ` Maxime Devos [this message]
2021-11-16 12:18 ` [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported Maxime Devos
2021-11-16 17:10 ` Maxime Devos
2021-11-16 11:06 ` [PATCH v2 02/14] Allow file ports in ‘readlink’ Maxime Devos
2021-11-16 11:06 ` [PATCH v2 03/14] Allow file ports in ‘utime’ Maxime Devos
2021-11-16 11:06 ` [PATCH v2 04/14] Define ‘symlinkat’ wrapper when supported Maxime Devos
2021-11-16 11:06 ` [PATCH v2 05/14] Define bindings to ‘mkdirat’ when the C function exists Maxime Devos
2021-11-16 11:06 ` [PATCH v2 06/14] Correct documentation of ‘mkdir’ w.r.t. the umask Maxime Devos
2021-11-16 11:06 ` [PATCH v2 07/14] Define AT_REMOVEDIR and others when available Maxime Devos
2021-11-16 11:06 ` [PATCH v2 08/14] Define a Scheme binding to ‘renameat’ when it exists Maxime Devos
2021-11-16 11:06 ` [PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ " Maxime Devos
2021-11-16 11:06 ` [PATCH v2 10/14] Define a Scheme binding to ‘unlinkat’ " Maxime Devos
2021-11-16 11:06 ` [PATCH v2 11/14] Define a Scheme binding to ‘fchownat’ " Maxime Devos
2021-11-16 11:06 ` [PATCH v2 12/14] Define a Scheme binding to ‘fstatat’ when available Maxime Devos
2021-11-16 11:06 ` [PATCH v2 13/14] Define Scheme bindings to ‘openat’ " Maxime Devos
2021-11-16 11:06 ` [PATCH v2 14/14] Update NEWS Maxime Devos
2021-11-16 12:16 ` Maxime Devos
2022-06-16 8:42 ` [PATCH v2 00/14] Bindings to *at functions Ludovic Courtès
2022-10-21 15:59 ` Ludovic Courtès
2022-10-21 16:03 ` Ludovic Courtès
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=20211116110637.125579-2-maximedevos@telenet.be \
--to=maximedevos@telenet.be \
--cc=guile-devel@gnu.org \
/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).