guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 08/14: Define a Scheme binding to ‘renameat’ when it exi


From: Ludovic Courtès
Subject: [Guile-commits] 08/14: Define a Scheme binding to ‘renameat’ when it exists.
Date: Thu, 16 Jun 2022 04:50:50 -0400 (EDT)

civodul pushed a commit to branch wip-openat
in repository guile.

commit a262605c0e32cc7a8fea10fb975e9414ac38d1f0
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Nov 16 11:06:31 2021 +0000

    Define a Scheme binding to ‘renameat’ when it exists.
    
    * 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.
    
    Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 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 da4b3ba6a..0a4fd035a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -529,7 +529,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)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]