From: Maxime Devos <maximedevos@telenet.be>
To: guile-devel@gnu.org
Cc: Maxime Devos <maximedevos@telenet.be>
Subject: [PATCH v2 08/14] Define a Scheme binding to ‘renameat’ when it exists.
Date: Tue, 16 Nov 2021 11:06:31 +0000 [thread overview]
Message-ID: <20211116110637.125579-9-maximedevos@telenet.be> (raw)
In-Reply-To: <20211116110637.125579-1-maximedevos@telenet.be>
* configure.ac: Detect if ‘renameat’ is defined.
* libguile/filesys.c (scm_renameat): Define a Scheme binding
to the ‘renameat’ system call.
* doc/ref/posix.texi (File System): Document it.
* libguile/filesys.h (scm_renameat): Make it part of the C API.
* test-suite/tests/filesys.test ("rename-file-at"): New tests.
---
configure.ac | 2 +-
doc/ref/posix.texi | 9 +++
libguile/filesys.c | 34 +++++++++++
libguile/filesys.h | 1 +
test-suite/tests/filesys.test | 104 ++++++++++++++++++++++++++++++++++
5 files changed, 149 insertions(+), 1 deletion(-)
diff --git a/configure.ac b/configure.ac
index da8dfadd0..e67892feb 100644
--- a/configure.ac
+++ b/configure.ac
@@ -485,7 +485,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
#
AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
fesetround ftime ftruncate fchown fchmod fchdir readlinkat \
- symlinkat mkdirat getcwd geteuid getsid \
+ symlinkat mkdirat renameat 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/posix.texi b/doc/ref/posix.texi
index 7f136376b..ebb001581 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -877,6 +877,15 @@ Renames the file specified by @var{oldname} to @var{newname}.
The return value is unspecified.
@end deffn
+@findex renameat
+@deffn {Scheme Procedure} rename-file-at olddir oldname newdir newname
+@deffnx {C Function} scm_renameat (olddir, oldname, newdir, newname)
+Like @code{rename-file}, but when @var{olddir} or @var{newdir} is true,
+resolve @var{oldname} or @var{newname} relative to the directory
+specified by the file port @var{olddir} or @var{newdir} instead of the
+current working directory.
+@end deffn
+
@deffn {Scheme Procedure} link oldpath newpath
@deffnx {C Function} scm_link (oldpath, newpath)
Creates a new name @var{newpath} in the file system for the
diff --git a/libguile/filesys.c b/libguile/filesys.c
index ee01b2e2c..9c63beaa8 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1421,6 +1421,40 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
}
#undef FUNC_NAME
+#ifdef HAVE_RENAMEAT
+SCM_DEFINE (scm_renameat, "rename-file-at", 4, 0, 0,
+ (SCM olddir, SCM oldname, SCM newdir, SCM newname),
+ "Like @code{rename-file}, but when @var{olddir} or @var{newdir}\n"
+ "is true, resolve @var{oldname} or @var{newname} relative to\n"
+ "the directory specified by file port @var{olddir} or\n"
+ "@var{newdir} instead of the current working directory.")
+#define FUNC_NAME s_scm_renameat
+{
+ int rv;
+ int old_fdes, new_fdes;
+
+ old_fdes = AT_FDCWD;
+ new_fdes = AT_FDCWD;
+
+ if (scm_is_true (olddir)) {
+ SCM_VALIDATE_OPFPORT (SCM_ARG1, olddir);
+ old_fdes = SCM_FPORT_FDES (olddir);
+ }
+ if (scm_is_true (newdir)) {
+ SCM_VALIDATE_OPFPORT (SCM_ARG3, newdir);
+ new_fdes = SCM_FPORT_FDES (newdir);
+ }
+
+ STRING2_SYSCALL (oldname, c_oldname,
+ newname, c_newname,
+ rv = renameat (old_fdes, c_oldname, new_fdes, c_newname));
+ scm_remember_upto_here_2 (olddir, newdir);
+ if (rv != 0)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
(SCM str),
diff --git a/libguile/filesys.h b/libguile/filesys.h
index f0dd35ede..7e17cc585 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -48,6 +48,7 @@ SCM_API SCM scm_close_fdes (SCM fd);
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_renameat (SCM olddir, SCM oldname, SCM newdir, SCM newname);
SCM_API SCM scm_delete_file (SCM str);
SCM_API SCM scm_mkdir (SCM path, SCM mode);
SCM_API SCM scm_mkdirat (SCM dir, SCM path, SCM mode);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 4ea62d513..bbce2c858 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -31,6 +31,8 @@
(data-file-name "filesys-test-link.tmp"))
(define (test-directory)
(data-file-name "filesys-test-dir.tmp"))
+(define (test-directory2)
+ (data-file-name "filesys-test-dir2.tmp"))
;;;
@@ -432,3 +434,105 @@
(mkdirat port (test-directory))
(stat:perms (stat (test-directory))))))
(maybe-delete-directory))
+
+(with-test-prefix "rename-file-at"
+ (define (skip-if-unsupported)
+ (unless (defined? 'rename-file-at)
+ (throw 'unsupported)))
+ (pass-if-equal "current working directory" '(#f "hello")
+ (skip-if-unsupported)
+ ;; Create a file in the test directory
+ (call-with-output-file "filesys-test-a.tmp"
+ (lambda (port) (display "hello" port)))
+ ;; Try to rename it
+ (rename-file-at #f "filesys-test-a.tmp" #f "filesys-test-b.tmp")
+ ;; Verify it exists under the new name, and not under the old name
+ (list (file-exists? "filesys-test-a.tmp")
+ (call-with-input-file "filesys-test-b.tmp" get-string-all)))
+
+ (false-if-exception (delete-file "filesys-test-a.tmp"))
+ (false-if-exception (delete-file "filesys-test-b.tmp"))
+
+ (pass-if-equal "two ports" '(#f "hello")
+ (skip-if-unsupported)
+ (mkdir (test-directory))
+ (mkdir (test-directory2))
+ ;; Create a file in the first directory
+ (call-with-output-file (in-vicinity (test-directory) "a")
+ (lambda (port) (display "hello" port)))
+ (let ((port1 (open (test-directory) O_RDONLY))
+ (port2 (open (test-directory2) O_RDONLY)))
+ ;; Try to rename it
+ (rename-file-at port1 "a" port2 "b")
+ (close-port port1)
+ (close-port port2)
+ ;; Verify it exists under the new name, and not under the old name
+ (list (file-exists? (in-vicinity (test-directory) "a"))
+ (call-with-input-file (in-vicinity (test-directory2) "b")
+ get-string-all))))
+ (false-if-exception (delete-file (in-vicinity (test-directory) "a")))
+ (false-if-exception (delete-file (in-vicinity (test-directory2) "b")))
+ (false-if-exception (rmdir (test-directory)))
+ (false-if-exception (rmdir (test-directory2)))
+
+ (pass-if-equal "port and current working directory" '(#f "hello")
+ (skip-if-unsupported)
+ (mkdir (test-directory))
+ ;; Create a file in (test-directory)
+ (call-with-output-file (in-vicinity (test-directory) "a")
+ (lambda (port) (display "hello" port)))
+ (let ((port (open (test-directory) O_RDONLY)))
+ ;; Try to rename it
+ (rename-file-at port "a" #f (basename (test-file)))
+ (close-port port)
+ ;; Verify it exists under the new name, and not under the old name.
+ (list (file-exists? (in-vicinity (test-directory) "a"))
+ (call-with-input-file (test-file) get-string-all))))
+ (false-if-exception (delete-file (in-vicinity (test-directory) "a")))
+ (false-if-exception (rmdir (test-directory)))
+ (false-if-exception (delete-file (test-file)))
+
+ (pass-if-equal "current working directory and port" '(#f "hello")
+ (skip-if-unsupported)
+ (mkdir (test-directory))
+ ;; Create a file in the working directory
+ (call-with-output-file (test-file)
+ (lambda (port) (display "hello" port)))
+ (let ((port (open (test-directory) O_RDONLY)))
+ ;; Try to rename it
+ (rename-file-at #f (basename (test-file)) port "b")
+ (close-port port)
+ ;; Verify it exists under the new name, and not under the old name.
+ (list (file-exists? (test-file))
+ (call-with-input-file (in-vicinity (test-directory) "b")
+ get-string-all))))
+
+ (false-if-exception (delete-file (in-vicinity (test-directory) "b")))
+ (false-if-exception (delete-file (test-file)))
+ (false-if-exception (rmdir (test-directory)))
+
+ (pass-if-exception "not a file port (1)" exception:wrong-type-arg
+ (skip-if-unsupported)
+ (rename-file-at (open-input-string "") "some" #f "thing"))
+
+ (pass-if-exception "not a file port (2)" exception:wrong-type-arg
+ (skip-if-unsupported)
+ (rename-file-at #f "some" (open-input-string "") "thing"))
+
+ (pass-if-exception "closed port (1)" exception:wrong-type-arg
+ (skip-if-unsupported)
+ (rename-file-at (call-with-port (open "." O_RDONLY) identity)
+ "some" #f "thing"))
+
+ (pass-if-exception "closed port (2)" exception:wrong-type-arg
+ (skip-if-unsupported)
+ (rename-file-at #f "some" (call-with-port (open "." O_RDONLY) identity)
+ "thing"))
+
+ (pass-if-exception "not a string (1)" exception:wrong-type-arg
+ (skip-if-unsupported)
+ (rename-file-at #f 'what #f "thing"))
+
+ (pass-if-exception "not a string (2)" exception:wrong-type-arg
+ (skip-if-unsupported)
+ (rename-file-at #f "some" #f 'what)))
--
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 ` [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported Maxime Devos
2021-11-16 12:18 ` 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 ` Maxime Devos [this message]
2021-11-16 11:06 ` [PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ when it exists 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-9-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).