[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-165-g06bfe27

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=06bfe276c8bfd71cf601761659d6b20acebc23b8

The branch, master has been updated
       via  06bfe276c8bfd71cf601761659d6b20acebc23b8 (commit)
      from  f826a8864a4ec7bfffac0f67d45f8ce0085e9d23 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 06bfe276c8bfd71cf601761659d6b20acebc23b8
Author: Andy Wingo <address@hidden>
Date:   Sun Jan 17 16:56:21 2010 +0100

    nanosecond timestamp support in stat and utime
    
    * libguile/posix.h:
    * libguile/posix.c (scm_utime): Add optional nanosecond arguments. This
      is an incompatible change on the C level, but it's unlikely people are
      using this POSIX wrapper function, because they would just use the
      POSIX function directly. Hopefully, anyway.
    
    * module/system/base/compile.scm (call-with-output-file/atomic):
      Propagate source timestamps to targets with nanosecond precision, if
      available. Fixes build on systems with ext4 filesystems.
    
    * libguile/filesys.c (scm_stat2scm):
    * module/ice-9/posix.scm (stat:atimensec, stat:mtimensec)
      (stat:ctimensec): Add three new elements to Scheme stat structures,
      for nanosecond-level timestamps.
    
    * configure.ac: Add checks for utimensat, and for nanosecond fields in
      struct stat. We should switch to using Gnulib things for these,
      though.
    
    * doc/ref/posix.texi (File System): Add documentation for utime's
      additional arguments, and nanosecond stat timestamp accessors.

-----------------------------------------------------------------------

Summary of changes:
 configure.ac                   |    8 +++-
 doc/ref/posix.texi             |   24 ++++++++---
 libguile/filesys.c             |   17 ++++++++-
 libguile/posix.c               |   84 ++++++++++++++++++++++++++++++++++------
 libguile/posix.h               |    3 +-
 module/ice-9/posix.scm         |    3 +
 module/system/base/compile.scm |    4 +-
 7 files changed, 120 insertions(+), 23 deletions(-)

diff --git a/configure.ac b/configure.ac
index 5143dcc..baac33d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -764,8 +764,9 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   _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
@@ -1157,7 +1158,10 @@ int main () { return (isnan(x) != 0); }]]),
 # 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],,,
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 2870459..6ff7109 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -687,13 +687,21 @@ case @code{stat:rdev} returns @code{#f}.
 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.
address@hidden deffn
address@hidden {Scheme Procedure} stat:atimensec st
address@hidden {Scheme Procedure} stat:mtimensec st
address@hidden {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
@@ -763,14 +771,18 @@ the new permissions as a decimal number, e.g., 
@code{(chmod "foo" #o755)}.
 The return value is unspecified.
 @end deffn
 
address@hidden {Scheme Procedure} utime pathname [actime [modtime]]
address@hidden {C Function} scm_utime (pathname, actime, modtime)
address@hidden file times
address@hidden {Scheme Procedure} utime pathname [actime [modtime [actimens 
[modtimens [flags]]]]]
address@hidden {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
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 3a2a47e..37b45de 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -405,7 +405,7 @@ SCM_SYMBOL (scm_sym_unknown, "unknown");
 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));
@@ -490,6 +490,21 @@ scm_stat2scm (struct stat_or_stat64 *stat_temp)
        
        */
   }  
+#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;
 }
diff --git a/libguile/posix.c b/libguile/posix.c
index ef52c38..f386fdf 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1373,13 +1373,18 @@ SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
 }
 #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"
@@ -1388,20 +1393,75 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
 #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, &times, 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;
diff --git a/libguile/posix.h b/libguile/posix.h
index 430d75b..420311e 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -70,7 +70,8 @@ SCM_API SCM scm_tmpnam (void);
 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);
diff --git a/module/ice-9/posix.scm b/module/ice-9/posix.scm
index a1be33c..b002676 100644
--- a/module/ice-9/posix.scm
+++ b/module/ice-9/posix.scm
@@ -33,6 +33,9 @@
 (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))
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 0caa248..977536f 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -88,7 +88,9 @@
            (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)))))))


hooks/post-receive
-- 
GNU Guile