Upgrade to Time-HiRes-1.92.

p4raw-id: //depot/perl@29010

6 files changed, 380 insertions, 30 deletions

diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes
index b878c284f5..07aed0254b 100644
--- a/ext/Time/HiRes/Changes
+++ b/ext/Time/HiRes/Changes
@@ -1,11 +1,51 @@
-Revision history for Perl extension Time::HiRes.
+Revision history for the Perl extension Time::HiRes.
 
-1.91	[2006-09-28]
+1.92	[2006-10-13]
+	- scan for subsecond resolution timestamps in struct stat,
+	  some known possibilities:
+
+	  (1)  struct  timespec st_atimespec;
+                                st_atimespec.tv_nsec;
+	  (2)  time_t  st_atime;
+	       long    st_atimensec;
+          (3)  time_t  st_atime;
+               int     st_atime_n;
+	  (4)  timestruc_t st_atim;
+                           st_atim.tv_nsec
+	  (5)  time_t  st_atime;
+               int     st_uatime;
+
+          If something like this is found, one can do
+
+	    use Time::HiRes;
+	    my @stat = Time::HiRes::stat();
+
+	  or even override the standard stat():
+      
+	    use Time::HiRes qw(stat);
+
+          to get the stat() timestamps
+
+	    my ($atime, $mtime, $ctime) = @stat[8, 9, 10];
+
+	  with subsecond resolution (assuming both the operating
+	  system and the filesystem support that kind of thing).
+
+	  Contributions for more systems (especially non-UNIX,
+	  e.g. but not limited to, Win32, VMS) gladly accepted.
+
+	  Thanks to H.Merijn Brand, John Peacock, and Craig
+	  Berry for brave beta testing.
+
+1.91	[2006-09-29]
 	- ualarm() in SuSE 10.1 was overflowing after ~4.2 seconds,
-	  probably due to a glibc bug/feature, workaround by using the
-	  setitimer() variant if either useconds or interval >= IV_1E6
-	  (this case seems to vary between systems: are useconds
-	   more than 999_999 for ualarm() defined or not)
+	  possibly due to a glibc bug/feature, workaround by using the
+	  setitimer() implementation of ualarm() if either useconds or
+	  interval > 999_999 (this case seems to vary between systems:
+	  are useconds more than 999_999 for ualarm() defined or not)
+	  Added more ualarm() tests to catch various overflow points,
+	  hopefully no problems in various platforms.
+	  (The problem report by Mark Seger and Jon Paul Sullivan of HP.)
 
 1.90	[2006-08-22]
 	- tweak still needed for Const64(), from Jerry Hedden
@@ -16,7 +56,8 @@ Revision history for Perl extension Time::HiRes.
 	- Const64() already appends an 'LL' (or i64), so provide LL and i64
 	  forms for the IV_1E[679] (effects Win32 and Cygwin), reported by
 	  Jerry Hedden.
-	- the Changes entry for 1.88 talked about [IN]V_1[679], missing the 'E'.
+	- the Changes entry for 1.88 talked about [IN]V_1[679],
+	  missing the 'E'.
 
 1.88	[2006-08-21]
 	- clean up the g++ warnings in HiRes.xs, all of them
diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
index b975262aa6..18241834c0 100644
--- a/ext/Time/HiRes/HiRes.pm
+++ b/ext/Time/HiRes/HiRes.pm
@@ -19,9 +19,11 @@ require DynaLoader;
 		 TIMER_ABSTIME
 		 d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
 		 d_nanosleep d_clock_gettime d_clock_getres
-		 d_clock d_clock_nanosleep);
+		 d_clock d_clock_nanosleep
+		 stat
+		);
 	
-$VERSION = '1.91';
+$VERSION = '1.92';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -83,7 +85,8 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
 =head1 SYNOPSIS
 
   use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep
-		      clock_gettime clock_getres clock_nanosleep clock );
+		      clock_gettime clock_getres clock_nanosleep clock
+                      stat );
 
   usleep ($microseconds);
   nanosleep ($nanoseconds);
@@ -119,6 +122,8 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
 
   my $ticktock = clock();
 
+  my @stat = stat(FH);
+
 =head1 DESCRIPTION
 
 The C<Time::HiRes> module implements a Perl interface to the
@@ -357,6 +362,31 @@ but not necessarily identical.  Note that due to backward
 compatibility limitations the returned value may wrap around at about
 2147 seconds or at about 36 minutes.
 
+=item stat
+
+=item stat FH
+
+=item stat EXPR
+
+As L<perlfunc/stat> but with the access/modify/change file timestamps
+in subsecond resolution, if the operating system and the filesystem
+both support such timestamps.  To override the standard stat():
+
+    use Time::HiRes qw(stat);
+
+Test for the value of &Time::HiRes::d_hires_stat to find out whether
+the operating system supports subsecond file timestamps: a value
+larger than zero means yes. There are unfortunately no easy
+ways to find out whether the filesystem supports such timestamps.
+
+A zero return value of &Time::HiRes::d_hires_stat means that
+Time::HiRes::stat is a no-op passthrough for CORE::stat(),
+and therefore the timestamps will stay integers.  The same
+will happen if the filesystem does not do subsecond timestamps.
+
+In any case do not expect nanosecond resolution, or even a microsecond
+resolution.
+
 =back
 
 =head1 EXAMPLES
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index c27c56314b..f1029f0795 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -479,6 +479,13 @@ hrt_ualarm_itimer(int usec, int interval)
    itv.it_interval.tv_usec = interval % IV_1E6;
    return setitimer(ITIMER_REAL, &itv, 0);
 }
+#ifdef HAS_UALARM
+int
+hrt_ualarm(int usec, int interval) /* for binary compat before 1.91 */
+{
+   return hrt_ualarm_itimer(usec, interval);
+}
+#endif /* #ifdef HAS_UALARM */
 #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */
 
 #if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
@@ -710,6 +717,42 @@ myNVtime()
 
 #endif /* #ifdef HAS_GETTIMEOFDAY */
 
+static void
+hrstatns(UV atime, UV mtime, UV ctime, UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec)
+{
+  dTHX;
+  *atime_nsec = 0;
+  *mtime_nsec = 0;
+  *ctime_nsec = 0;
+#ifdef TIME_HIRES_STAT
+#if TIME_HIRES_STAT == 1
+  *atime_nsec = PL_statcache.st_atimespec.tv_nsec;
+  *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec;
+  *ctime_nsec = PL_statcache.st_ctimespec.tv_nsec;
+#endif
+#if TIME_HIRES_STAT == 2
+  *atime_nsec = PL_statcache.st_atimensec;
+  *mtime_nsec = PL_statcache.st_mtimensec;
+  *ctime_nsec = PL_statcache.st_ctimensec;
+#endif
+#if TIME_HIRES_STAT == 3
+  *atime_nsec = PL_statcache.st_atime_n;
+  *mtime_nsec = PL_statcache.st_mtime_n;
+  *ctime_nsec = PL_statcache.st_ctime_n;
+#endif
+#if TIME_HIRES_STAT == 4
+  *atime_nsec = PL_statcache.st_atim.tv_nsec;
+  *mtime_nsec = PL_statcache.st_mtim.tv_nsec;
+  *ctime_nsec = PL_statcache.st_ctim.tv_nsec;
+#endif
+#if TIME_HIRES_STAT == 5
+  *atime_nsec = PL_statcache.st_uatime * 1000;
+  *mtime_nsec = PL_statcache.st_umtime * 1000;
+  *ctime_nsec = PL_statcache.st_uctime * 1000;
+#endif
+#endif
+}
+
 #include "const-c.inc"
 
 MODULE = Time::HiRes            PACKAGE = Time::HiRes
@@ -1166,3 +1209,34 @@ clock()
 
 #endif /*  #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
 
+IV
+stat(...)
+PROTOTYPE: ;$
+    PPCODE:
+	PUSHMARK(SP);
+	XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV)));
+	PUTBACK;
+	ENTER;
+	PL_laststatval = -1;
+	(void)*(PL_ppaddr[OP_STAT])(aTHX);
+	SPAGAIN;
+	LEAVE;
+	if (PL_laststatval == 0) {
+	  /* We assume that pp_stat() left us with 13 valid stack items. */
+	  UV atime = SvUV(ST( 8));
+	  UV mtime = SvUV(ST( 9));
+	  UV ctime = SvUV(ST(10));
+	  UV atime_nsec;
+	  UV mtime_nsec;
+	  UV ctime_nsec;
+	  hrstatns(atime, mtime, ctime,
+		   &atime_nsec, &mtime_nsec, &ctime_nsec);
+	  if (atime_nsec)
+	    ST( 8) = sv_2mortal(newSVnv(atime + 1e-9 * (NV) atime_nsec));
+	  if (mtime_nsec)
+	    ST( 9) = sv_2mortal(newSVnv(mtime + 1e-9 * (NV) mtime_nsec));
+	  if (ctime_nsec)
+	    ST(10) = sv_2mortal(newSVnv(ctime + 1e-9 * (NV) ctime_nsec));
+	  XSRETURN(13);
+	}
+	XSRETURN(0);
diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL
index 5e54b4976d..115cea36f5 100644
--- a/ext/Time/HiRes/Makefile.PL
+++ b/ext/Time/HiRes/Makefile.PL
@@ -169,24 +169,26 @@ EOF
     return $ok;
 }
 
-sub has_gettimeofday {
-    # confusing but true (if condition true ==> -DHAS_GETTIMEOFDAY already)
-    return 0 if $Config{d_gettimeod};
-    return 1 if try_compile_and_link(<<EOM);
+my $TIME_HEADERS = <<EOH;
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 #ifdef I_SYS_TYPES
 #   include <sys/types.h>
 #endif
-
 #ifdef I_SYS_TIME
 #   include <sys/time.h>
 #endif
-
 #ifdef I_SYS_SELECT
 #   include <sys/select.h>	/* struct timeval might be hidden in here */
 #endif
+EOH
+
+sub has_gettimeofday {
+    # confusing but true (if condition true ==> -DHAS_GETTIMEOFDAY already)
+    return 0 if $Config{d_gettimeod};
+    return 1 if try_compile_and_link(<<EOM);
+$TIME_HEADERS
 static int foo()
 {
     struct timeval tv;
@@ -589,6 +591,113 @@ EOD
 	print "NOT found.\n";
     }
 
+    print "Trying struct stat st_atimespec.tv_nsec...";
+    my $has_stat_st_xtimespec;
+    if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main() {
+    struct stat st;
+    st.st_atimespec.tv_nsec = 0;
+}
+EOM
+      $has_stat_st_xtimespec++;
+      $DEFINE .= ' -DTIME_HIRES_STAT=1';
+    }
+
+    if ($has_stat_st_xtimespec) {
+        print "found.\n";
+    } else {
+	print "NOT found.\n";
+    }
+
+    print "Trying struct stat st_atimensec...";
+    my $has_stat_st_xtimensec;
+    if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main() {
+    struct stat st;
+    st.st_atimensec = 0;
+}
+EOM
+      $has_stat_st_xtimensec++;
+      $DEFINE .= ' -DTIME_HIRES_STAT=2';
+    }
+
+    if ($has_stat_st_xtimensec) {
+        print "found.\n";
+    } else {
+	print "NOT found.\n";
+    }
+
+    print "Trying struct stat st_atime_n...";
+    my $has_stat_st_xtime_n;
+    if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main() {
+    struct stat st;
+    st.st_atime_n = 0;
+}
+EOM
+      $has_stat_st_xtime_n++;
+      $DEFINE .= ' -DTIME_HIRES_STAT=3';
+    }
+
+    if ($has_stat_st_xtime_n) {
+        print "found.\n";
+    } else {
+	print "NOT found.\n";
+    }
+
+    print "Trying struct stat st_atim.tv_nsec...";
+    my $has_stat_st_xtim;
+    if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main() {
+    struct stat st;
+    st.st_atim.tv_nsec = 0;
+}
+EOM
+      $has_stat_st_xtim++;
+      $DEFINE .= ' -DTIME_HIRES_STAT=4';
+    }
+
+    if ($has_stat_st_xtim) {
+        print "found.\n";
+    } else {
+	print "NOT found.\n";
+    }
+
+    print "Trying struct stat st_uatime...";
+    my $has_stat_st_uxtime;
+    if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main() {
+    struct stat st;
+    st.st_uatime = 0;
+}
+EOM
+      $has_stat_st_uxtime++;
+      $DEFINE .= ' -DTIME_HIRES_STAT=5';
+    }
+
+    if ($has_stat_st_uxtime) {
+        print "found.\n";
+    } else {
+	print "NOT found.\n";
+    }
+
+   if ($DEFINE =~ /-DTIME_HIRES_STAT=\d+/) {
+    print "You seem to have stat subsecond timestamps.\n";
+    print "(Your struct stat has them, but the filesystems must help.)\n";
+   } else {
+    print "You do not seem to have stat subsecond timestamps.\n";
+   }
+
     my $has_w32api_windows_h;
 
     if ($^O eq 'cygwin') {
@@ -652,22 +761,28 @@ sub doMakefile {
 
 sub doConstants {
     if (eval {require ExtUtils::Constant; 1}) {
-	my @names = (qw(CLOCK_HIGHRES CLOCK_MONOTONIC
-			CLOCK_PROCESS_CPUTIME_ID
-			CLOCK_REALTIME
-			CLOCK_SOFTTIME
-			CLOCK_THREAD_CPUTIME_ID
-			CLOCK_TIMEOFDAY
-			CLOCKS_PER_SEC
-			ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
-			ITIMER_REALPROF
-			TIMER_ABSTIME));
+	my @names = qw(CLOCK_HIGHRES CLOCK_MONOTONIC
+		       CLOCK_PROCESS_CPUTIME_ID
+		       CLOCK_REALTIME
+		       CLOCK_SOFTTIME
+		       CLOCK_THREAD_CPUTIME_ID
+		       CLOCK_TIMEOFDAY
+		       CLOCKS_PER_SEC
+		       ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
+		       ITIMER_REALPROF
+		       TIMER_ABSTIME);
 	foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
 		     d_nanosleep d_clock_gettime d_clock_getres
-		     d_clock d_clock_nanosleep)) {
+		     d_clock d_clock_nanosleep d_hires_stat)) {
 	    my $macro = $_;
 	    if ($macro =~ /^(d_nanosleep|d_clock_gettime|d_clock_getres|d_clock|d_clock_nanosleep)$/) {
 		$macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
+	    } elsif ($macro =~ /^(d_hires_stat)$/) {
+		my $d_hires_stat = 0;
+		$d_hires_stat = $1 if ($DEFINE =~ /-DTIME_HIRES_STAT=(\d+)/);
+		push @names, {name => $_, macro => "TIME_HIRES_STAT", value => $d_hires_stat,
+			      default => ["IV", "0"]};
+		next;
 	    } else {
 		$macro =~ s/^d_(.+)/HAS_\U$1/;
 	    }
diff --git a/ext/Time/HiRes/hints/aix.pl b/ext/Time/HiRes/hints/aix.pl
new file mode 100644
index 0000000000..bbb7fa8342
--- /dev/null
+++ b/ext/Time/HiRes/hints/aix.pl
@@ -0,0 +1,18 @@
+# Many AIX installations seem not to have the right PATH
+# for the C compiler.  Steal the logic from Perl's hints/aix.sh.
+use Config;
+unless ($Config{gccversion}) {
+    my $cc = $Config{cc};
+    if (! -x $cc && -x "/usr/vac/bin/$cc") {
+	unless (":$ENV{PATH}:" =~ m{:/usr/vac/bin:}) {
+	    die <<__EOE__;
+***
+*** You either implicitly or explicitly specified an IBM C compiler,
+*** but you do not seem to have one in /usr/bin, but you seem to have
+*** the VAC installed in /usr/vac, but you do not have the /usr/vac/bin
+*** in your PATH.  I suggest adding that and retrying Makefile.PL.
+***
+__EOE__
+	}
+    }
+}
diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t
index cae9889f11..3ac0ca14ef 100644
--- a/ext/Time/HiRes/t/HiRes.t
+++ b/ext/Time/HiRes/t/HiRes.t
@@ -12,7 +12,7 @@ BEGIN {
     }
 }
 
-BEGIN { $| = 1; print "1..33\n"; }
+BEGIN { $| = 1; print "1..38\n"; }
 
 END { print "not ok 1\n" unless $loaded }
 
@@ -32,6 +32,7 @@ my $have_clock_gettime	 = &Time::HiRes::d_clock_gettime;
 my $have_clock_getres	 = &Time::HiRes::d_clock_getres;
 my $have_clock_nanosleep = &Time::HiRes::d_clock_nanosleep;
 my $have_clock           = &Time::HiRes::d_clock;
+my $have_hires_stat      = &Time::HiRes::d_hires_stat;
 
 sub has_symbol {
     my $symbol = shift;
@@ -49,6 +50,7 @@ printf "# have_clock_gettime   = %d\n", $have_clock_gettime;
 printf "# have_clock_getres    = %d\n", $have_clock_getres;
 printf "# have_clock_nanosleep = %d\n", $have_clock_nanosleep;
 printf "# have_clock           = %d\n", $have_clock;
+printf "# have_hires_stat      = %d\n", $have_hires_stat;
 
 import Time::HiRes 'gettimeofday'	if $have_gettimeofday;
 import Time::HiRes 'usleep'		if $have_usleep;
@@ -65,7 +67,7 @@ use Time::HiRes qw(gettimeofday);
 
 my $have_alarm = $Config{d_alarm};
 my $have_fork  = $Config{d_fork};
-my $waitfor = 60; # 10-20 seconds is normal (load affects this).
+my $waitfor = 90; # 30-45 seconds is normal (load affects this).
 my $timer_pid;
 my $TheEnd;
 
@@ -584,10 +586,80 @@ if ($have_clock) {
 	print "not ok 33\n";
     }
 } else {
-    print "# No clock\n";
     skip 33;
 }
 
+if ($have_ualarm) {
+    # 1_100_000 sligthly over 1_000_000,
+    # 2_200_000 slightly over 2**31/1000,
+    # 4_300_000 slightly over 2**32/1000.
+    for my $t ([34, 100_000],
+	       [35, 1_100_000],
+	       [36, 2_200_000],
+	       [37, 4_300_000]) {
+	my ($i, $n) = @$t;
+	my $alarmed = 0;
+	local $SIG{ ALRM } = sub { $alarmed++ };
+	my $t0 = Time::HiRes::time();
+	print "# t0 = $t0\n";
+	print "# ualarm($n)\n";
+	ualarm($n); 1 while $alarmed == 0;
+	my $t1 = Time::HiRes::time();
+	print "# t1 = $t1\n";
+	my $dt = $t1 - $t0;
+	print "# dt = $dt\n";
+	ok $i, $dt >= $n/1e6 &&
+	    ($n < 1_000_000 # Too much noise.
+	     || $dt <= 1.5*$n/1e6), "ualarm($n) close enough";
+    }
+} else {
+    print "# No ualarm\n";
+    skip 34..37;
+}
+
+if (&Time::HiRes::d_hires_stat) {
+    my @stat;
+    my @time;
+    for (1..5) {
+	Time::HiRes::sleep(rand(0.1) + 0.1);
+	open(X, ">$$");
+	print X $$;
+	close(X);
+	@stat = Time::HiRes::stat($$);
+	push @time, $stat[9];
+	Time::HiRes::sleep(rand(0.1) + 0.1);
+	open(X, "<$$");
+	<X>;
+	close(X);
+	@stat = Time::HiRes::stat($$);
+	push @time, $stat[8];
+    }
+    1 while unlink $$;
+    print "# @time\n";
+    my $mi = 1;
+    my $ss = 0;
+    for (my $i = 1; $i < @time; $i++) {
+	if ($time[$i] > $time[$i-1]) {
+	    $mi++;
+	}
+	if ($time[$i] > int($time[$i])) {
+	    $ss++;
+	}
+    }
+    # Need at least 80% of monotonical increase and subsecond results.
+    if ($ss == 0) {
+	print "# No subsecond timestamps detected\n";
+	skip 38;
+    } elsif ($mi/@time > 0.8 && $ss/@time > 0.8) {
+	print "ok 38\n";
+    } else {
+	print "not ok 38\n";
+    }
+} else {
+    print "# No effectual d_hires_stat\n";
+    skip 38;
+}
+
 END {
     if ($timer_pid) { # Only in the main process.
 	my $left = $TheEnd - time();