# _NSGetEnviron - Darwin specific
# strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin
# nl_langinfo - X/Open, not available on Windows.
+# utimensat: posix.1-2008
#
-AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid getsid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo])
+AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid getsid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo utimensat])
# Reasons for testing:
# netdb.h - not in mingw
# Note AC_STRUCT_ST_BLOCKS is not used here because we don't want the
# AC_LIBOBJ(fileblocks) replacement which that macro gives.
#
-AC_CHECK_MEMBERS([struct stat.st_rdev, struct stat.st_blksize, struct stat.st_blocks])
+AC_CHECK_MEMBERS([struct stat.st_rdev, struct stat.st_blksize, struct stat.st_blocks, struct stat.st_atim, struct stat.st_mtim, struct stat.st_ctim],,,
+ [#define _GNU_SOURCE
+AC_INCLUDES_DEFAULT
+])
AC_STRUCT_TIMEZONE
AC_CHECK_MEMBERS([struct tm.tm_gmtoff],,,
The size of a regular file in bytes.
@end deffn
@deffn {Scheme Procedure} stat:atime st
-The last access time for the file.
+The last access time for the file, in seconds.
@end deffn
@deffn {Scheme Procedure} stat:mtime st
-The last modification time for the file.
+The last modification time for the file, in seconds.
@end deffn
@deffn {Scheme Procedure} stat:ctime st
-The last modification time for the attributes of the file.
+The last modification time for the attributes of the file, in seconds.
+@end deffn
+@deffn {Scheme Procedure} stat:atimensec st
+@deffnx {Scheme Procedure} stat:mtimensec st
+@deffnx {Scheme Procedure} stat:ctimensec st
+The fractional part of a file's access, modification, or attribute modification
+time, in nanoseconds. Nanosecond timestamps are only available on some operating
+systems and filesystems. If Guile cannot retrieve nanosecond-level timestamps
+for a file, these fields will be set to 0.
@end deffn
@deffn {Scheme Procedure} stat:blksize st
The optimal block size for reading or writing the file, in bytes. On
The return value is unspecified.
@end deffn
-@deffn {Scheme Procedure} utime pathname [actime [modtime]]
-@deffnx {C Function} scm_utime (pathname, actime, modtime)
-@cindex file times
+@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{path}. 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.
+
+The optional @var{actimens} and @var{modtimens} are nanoseconds
+to add @var{actime} and @var{modtime}. Nanosecond precision is
+only supported on some combinations of filesystems and operating
+systems.
@lisp
(utime "foo" (- (current-time) 3600))
@end lisp
static SCM
scm_stat2scm (struct stat_or_stat64 *stat_temp)
{
- SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
+ SCM ans = scm_c_make_vector (18, SCM_UNSPECIFIED);
SCM_SIMPLE_VECTOR_SET(ans, 0, scm_from_ulong (stat_temp->st_dev));
SCM_SIMPLE_VECTOR_SET(ans, 1, scm_from_ino_t_or_ino64_t (stat_temp->st_ino));
*/
}
+#ifdef HAVE_STRUCT_STAT_ST_ATIM
+ SCM_SIMPLE_VECTOR_SET(ans, 15, scm_from_long (stat_temp->st_atim.tv_nsec));
+#else
+ SCM_SIMPLE_VECTOR_SET(ans, 15, SCM_I_MAKINUM (0));
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_MTIM
+ SCM_SIMPLE_VECTOR_SET(ans, 16, scm_from_long (stat_temp->st_mtim.tv_nsec));
+#else
+ SCM_SIMPLE_VECTOR_SET(ans, 16, SCM_I_MAKINUM (0));
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_CTIM
+ SCM_SIMPLE_VECTOR_SET(ans, 17, scm_from_ulong (stat_temp->st_ctim.tv_sec));
+#else
+ SCM_SIMPLE_VECTOR_SET(ans, 17, SCM_I_MAKINUM (0));
+#endif
return ans;
}
}
#undef FUNC_NAME
-SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
- (SCM pathname, SCM actime, SCM modtime),
+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{path}. 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"
+ "@code{current-time} procedure.\n\n"
+ "The optional @var{actimens} and @var{modtimens} are nanoseconds\n"
+ "to add @var{actime} and @var{modtime}. Nanosecond precision is\n"
+ "only supported on some combinations of filesystems and operating\n"
+ "systems.\n"
"@lisp\n"
"(utime \"foo\" (- (current-time) 3600))\n"
"@end lisp\n"
#define FUNC_NAME s_scm_utime
{
int rv;
- struct utimbuf utm_tmp;
-
+ time_t atim_sec, mtim_sec;
+ long atim_nsec, mtim_nsec;
+ int f;
+
if (SCM_UNBNDP (actime))
- SCM_SYSCALL (time (&utm_tmp.actime));
+ {
+#if HAVE_UTIMENSAT
+ atim_sec = 0;
+ atim_nsec = UTIME_NOW;
+#else
+ SCM_SYSCALL (time (&atim_sec));
+ atim_nsec = 0;
+#endif
+ }
else
- utm_tmp.actime = SCM_NUM2ULONG (2, actime);
-
+ {
+ atim_sec = SCM_NUM2ULONG (2, actime);
+ if (SCM_UNBNDP (actimens))
+ atim_nsec = 0;
+ else
+ atim_nsec = SCM_NUM2LONG (4, actimens);
+ }
+
if (SCM_UNBNDP (modtime))
- SCM_SYSCALL (time (&utm_tmp.modtime));
+ {
+#if HAVE_UTIMENSAT
+ mtim_sec = 0;
+ mtim_nsec = UTIME_NOW;
+#else
+ SCM_SYSCALL (time (&mtim_sec));
+ mtim_nsec = 0;
+#endif
+ }
else
- utm_tmp.modtime = SCM_NUM2ULONG (3, modtime);
+ {
+ mtim_sec = SCM_NUM2ULONG (3, modtime);
+ if (SCM_UNBNDP (modtimens))
+ mtim_nsec = 0;
+ else
+ mtim_nsec = SCM_NUM2LONG (5, modtimens);
+ }
+
+ if (SCM_UNBNDP (flags))
+ f = 0;
+ else
+ f = SCM_NUM2INT (6, flags);
+
+#if HAVE_UTIMENSAT
+ {
+ struct timespec times[2];
+ times[0].tv_sec = atim_sec;
+ times[0].tv_nsec = atim_nsec;
+ times[1].tv_sec = mtim_sec;
+ times[1].tv_nsec = mtim_nsec;
+
+ STRING_SYSCALL (pathname, c_pathname,
+ rv = utimensat (AT_FDCWD, c_pathname, ×, f));
+ }
+#else
+ {
+ struct utimbuf utm;
+ utm.actime = atim_sec;
+ utm.modtime = mtim_sec;
+
+ STRING_SYSCALL (pathname, c_pathname,
+ rv = utime (c_pathname, &utm));
+ }
+#endif
- STRING_SYSCALL (pathname, c_pathname,
- rv = utime (c_pathname, &utm_tmp));
if (rv != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
SCM_API SCM scm_mkstemp (SCM tmpl);
SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
SCM_API SCM scm_close_pipe (SCM port);
-SCM_API SCM scm_utime (SCM pathname, SCM actime, SCM modtime);
+SCM_API SCM scm_utime (SCM pathname, SCM actime, SCM modtime,
+ SCM actimens, SCM modtimens, SCM flags);
SCM_API SCM scm_access (SCM path, SCM how);
SCM_API SCM scm_getpid (void);
SCM_API SCM scm_putenv (SCM str);
(define (stat:ctime f) (vector-ref f 10))
(define (stat:blksize f) (vector-ref f 11))
(define (stat:blocks f) (vector-ref f 12))
+(define (stat:atimensec f) (vector-ref f 15))
+(define (stat:mtimensec f) (vector-ref f 16))
+(define (stat:ctimensec f) (vector-ref f 17))
;; derived from stat mode.
(define (stat:type f) (vector-ref f 13))
(close-port tmp)
(if reference
(let ((st (stat reference)))
- (utime template (stat:atime st) (stat:mtime st))))
+ (utime template
+ (stat:atime st) (stat:mtime st)
+ (stat:atimensec st) (stat:mtimensec st))))
(rename-file template filename))
(lambda args
(delete-file template)))))))
projects / platform / upstream / guile.git / commitdiff