This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Time-HiRes-1.93.
authorSteve Peters <steve@fisharerojo.org>
Sun, 15 Oct 2006 17:17:32 +0000 (17:17 +0000)
committerSteve Peters <steve@fisharerojo.org>
Sun, 15 Oct 2006 17:17:32 +0000 (17:17 +0000)
p4raw-id: //depot/perl@29023

ext/Time/HiRes/Changes
ext/Time/HiRes/HiRes.pm
ext/Time/HiRes/t/HiRes.t

index 07aed02..e0a160a 100644 (file)
@@ -1,5 +1,17 @@
 Revision history for the Perl extension Time::HiRes.
 
+1.93   [2006-10-15]
+       - the ualarm() tests (34-37) assumed that ualarm(N)
+         could never alarm in less than N seconds, widened
+         the acceptable relative range to 0.9..1.5.  Addresses
+         [rt.cpan.org #22090] and [rt.cpan.org #22091].
+
+       - skip the stat() tests in cygwin and win32, because
+         if run on FAT the timestamp granularity is only 2 seconds.
+         Any good way to detect (cygwin or win32) whether we are
+         being run on NTFS or anyplace with better timestamps?
+         Addresses [rt.cpan.org #22089] and [rt.cpan.org #22098].
+
 1.92   [2006-10-13]
        - scan for subsecond resolution timestamps in struct stat,
          some known possibilities:
index 1824183..0d5f56e 100644 (file)
@@ -23,7 +23,7 @@ require DynaLoader;
                 stat
                );
        
-$VERSION = '1.92';
+$VERSION = '1.93';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -122,6 +122,7 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
 
   my $ticktock = clock();
 
+  my @stat = stat("file");
   my @stat = stat(FH);
 
 =head1 DESCRIPTION
@@ -378,11 +379,14 @@ 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.
+UNIX filesystems often do; NTFS does; FAT doesn't (FAT timestamp
+granularity is B<two> seconds).
 
 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.
+will happen if the filesystem does not do subsecond timestamps,
+even if the &Time::HiRes::d_hires_stat is non-zero.
 
 In any case do not expect nanosecond resolution, or even a microsecond
 resolution.
@@ -451,6 +455,9 @@ resolution.
   my $clock1 = clock();
   my $clockd = $clock1 - $clock0;
 
+  use Time::HiRes qw( stat );
+  my ($atime, $mtime, $ctime) = (stat("istics"))[8, 9, 10];
+
 =head1 C API
 
 In addition to the perl API described above, a C API is available for
index 3ac0ca1..2a9f313 100644 (file)
@@ -16,6 +16,7 @@ BEGIN { $| = 1; print "1..38\n"; }
 
 END { print "not ok 1\n" unless $loaded }
 
+use Time::HiRes 1.93; # Remember to bump this once in a while.
 use Time::HiRes qw(tv_interval);
 
 $loaded = 1;
@@ -608,16 +609,20 @@ if ($have_ualarm) {
        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";
+       my $r = $dt / ($n/1e6);
+       ok $i,
+       ($n < 1_000_000 || # Too much noise.
+        $r >= 0.9 && $r <= 1.5), "ualarm($n) close enough";
     }
 } else {
     print "# No ualarm\n";
     skip 34..37;
 }
 
-if (&Time::HiRes::d_hires_stat) {
+if ($^O =~ /^(cygwin|MSWin)/) {
+    print "# $^O: timestamps may not be good enough\n";
+    skip 38;
+} elsif (&Time::HiRes::d_hires_stat) {
     my @stat;
     my @time;
     for (1..5) {
@@ -646,11 +651,12 @@ if (&Time::HiRes::d_hires_stat) {
            $ss++;
        }
     }
-    # Need at least 80% of monotonical increase and subsecond results.
+    # Need at least 80% of monotonical increase and 20% subsecond results.
+    # Yes, this is shameless guessing of numbers.
     if ($ss == 0) {
        print "# No subsecond timestamps detected\n";
        skip 38;
-    } elsif ($mi/@time > 0.8 && $ss/@time > 0.8) {
+    } elsif ($mi/@time > 0.8 && $ss/@time > 0.2) {
        print "ok 38\n";
     } else {
        print "not ok 38\n";