From 021567541a2685b6b7467d08188c51cd22368374 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Wed, 10 Mar 2021 15:02:03 +0100 Subject: [PATCH 04/17] =?UTF-8?q?Accept=20open=20file=20ports=20in=20?= =?UTF-8?q?=E2=80=98utime=E2=80=99=20when=20supported.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * configure.ac: Detect if the ‘futimens’ system call is defined. * libguile/posix.c (scm_utime): Allow file ports if the ‘futimens’ and ‘utimensat’ system calls are defined. * doc/ref/posix.texi (File System): Document it. * test-suite/tests/posix.test: Test it. --- configure.ac | 4 ++-- doc/ref/posix.texi | 10 ++++++---- libguile/posix.c | 22 +++++++++++++++++++--- test-suite/tests/posix.test | 33 +++++++++++++++++++++++++++++++-- 4 files changed, 58 insertions(+), 11 deletions(-) diff --git a/configure.ac b/configure.ac index 0f032272a..551856fc4 100644 --- a/configure.ac +++ b/configure.ac @@ -474,7 +474,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) # truncate - not in mingw # isblank - available as a GNU extension or in C99 # _NSGetEnviron - Darwin specific -# strcoll_l, newlocale, uselocale, utimensat - POSIX.1-2008 +# strcoll_l, newlocale, uselocale, utimensat, futimens - POSIX.1-2008 # strtol_l - non-POSIX, found in glibc # fork - unavailable on Windows # sched_getaffinity, sched_setaffinity - GNU extensions (glibc) @@ -491,7 +491,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp \ index bcopy memcpy rindex truncate isblank _NSGetEnviron \ strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat \ - sched_getaffinity sched_setaffinity sendfile]) + sched_getaffinity sched_setaffinity sendfile futimens]) # The newlib C library uses _NL_ prefixed locale langinfo constants. AC_CHECK_DECLS([_NL_NUMERIC_GROUPING], [], [], [[#include ]]) diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 68de5a2ed..80ee02b93 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -832,7 +832,8 @@ The return value is unspecified. @deffn {Scheme Procedure} utime pathname [actime [modtime [actimens [modtimens [flags]]]]] @deffnx {C Function} scm_utime (pathname, actime, modtime, actimens, modtimens, flags) @code{utime} sets the access and modification times for the -file named by @var{pathname}. If @var{actime} or @var{modtime} is +file named by @var{pathname} (a string, or a file port if supported +by the host system). If @var{actime} or @var{modtime} is not supplied, then the current time is used. @var{actime} and @var{modtime} must be integer time values as returned by the @code{current-time} procedure. @@ -848,9 +849,10 @@ will set the access time to one hour in the past and the modification time to the current time. @vindex AT_SYMLINK_NOFOLLOW -Last, @var{flags} may be either @code{0} or the -@code{AT_SYMLINK_NOFOLLOW} constant, to set the time of -@var{pathname} even if it is a symbolic link. +Last, @var{flags} may be either @code{0} or; +if @var{pathname} is not a port, the @code{AT_SYMLINK_NOFOLLOW} +constant, to set the time of @var{pathname} even if it is a +symbolic link. @end deffn @findex unlink diff --git a/libguile/posix.c b/libguile/posix.c index f76722a43..351ce8c0c 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1629,7 +1629,8 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0, (SCM pathname, SCM actime, SCM modtime, SCM actimens, SCM modtimens, SCM flags), "@code{utime} sets the access and modification times for the\n" - "file named by @var{pathname}. If @var{actime} or @var{modtime} is\n" + "file named by @var{pathname} (a string, or a file port if\n" + "supported by the host system). If @var{actime} or @var{modtime} is\n" "not supplied, then the current time is used. @var{actime} and\n" "@var{modtime} must be integer time values as returned by the\n" "@code{current-time} procedure.\n\n" @@ -1703,8 +1704,23 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0, times[1].tv_sec = mtim_sec; times[1].tv_nsec = mtim_nsec; - STRING_SYSCALL (pathname, c_pathname, - rv = utimensat (AT_FDCWD, c_pathname, times, f)); +#ifdef HAVE_FUTIMENS + if (SCM_OPFPORTP (pathname)) + { + int fd; + fd = SCM_FPORT_FDES (pathname); + if (f != 0) + scm_out_of_range (FUNC_NAME, flags); + + SCM_SYSCALL (rv = futimens (fd, times)); + scm_remember_upto_here_1 (pathname); + } + else +#endif + { + STRING_SYSCALL (pathname, c_pathname, + rv = utimensat (AT_FDCWD, c_pathname, times, f)); + } } #else { diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test index 135f09c11..88f9d8a58 100644 --- a/test-suite/tests/posix.test +++ b/test-suite/tests/posix.test @@ -1,6 +1,6 @@ ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*- ;;;; -;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019 +;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019,2021 ;;;; Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -211,7 +211,36 @@ (list (stat:atime info) (stat:mtime info)))) (lambda () (delete-file file)))) - (throw 'unsupported)))) + (throw 'unsupported))) + + (pass-if-equal "file port" + '(1 1) + (let ((file "posix.test-utime")) + (dynamic-wind + (lambda () + (close-port (open-output-file file))) + (lambda () + (with-input-from-file file + (lambda () + (catch 'system-error + (lambda () + (catch 'wrong-type-arg + (lambda () + (utime file 1 1 0 0)) + ;; 'futimens' is not supported on all + ;; platforms. + (lambda _ + (throw 'unsupported)))) + (lambda args + ;; On some platforms, 'futimens' returns + ;; ENOSYS according to Gnulib. + (if (= (system-error-errno args) ENOSYS) + (throw 'unsupported) + (apply throw args)))))) + (let ((info (stat file))) + (list (stat:atime info) (stat:mtime info)))) + (lambda () + (delete-file file)))))) ;; ;; affinity -- 2.30.2