From c09e847b4c6a9134b3f00f61d4921cc4f33fa3b2 Mon Sep 17 00:00:00 2001 From: Steve Peters Date: Sun, 15 Oct 2006 17:17:32 +0000 Subject: [PATCH] Upgrade to Time-HiRes-1.93. p4raw-id: //depot/perl@29023 --- ext/Time/HiRes/Changes | 12 ++++++++++++ ext/Time/HiRes/HiRes.pm | 11 +++++++++-- ext/Time/HiRes/t/HiRes.t | 18 ++++++++++++------ 3 files changed, 33 insertions(+), 8 deletions(-) diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index 07aed02..e0a160a 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -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: diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index 1824183..0d5f56e 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -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 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 diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index 3ac0ca1..2a9f313 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -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"; -- 2.7.4