From c36568be88bd894c59f9e2994c64120ffb2941bb Mon Sep 17 00:00:00 2001 From: Steve Peters Date: Tue, 17 Oct 2006 15:43:05 +0000 Subject: [PATCH] Upgrade to Time-HiRes-1.94. p4raw-id: //depot/perl@29031 --- ext/Time/HiRes/Changes | 6 ++++ ext/Time/HiRes/HiRes.pm | 2 +- ext/Time/HiRes/t/HiRes.t | 77 +++++++++++++++++++++++++++++------------------- 3 files changed, 53 insertions(+), 32 deletions(-) diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index e0a160a..6769b84 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,5 +1,11 @@ Revision history for the Perl extension Time::HiRes. +1.94 [2006-10-16] + - file timestamps oddities seen: the atime and mtime + can be out of sync (modify first and read second can leave + atime < mtime) and mtime can be subsecond while atime is not. + So make the test more forgiving. + 1.93 [2006-10-15] - the ualarm() tests (34-37) assumed that ualarm(N) could never alarm in less than N seconds, widened diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index 0d5f56e..96e2f42 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -23,7 +23,7 @@ require DynaLoader; stat ); -$VERSION = '1.93'; +$VERSION = '1.94'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index 2a9f313..2ef3b2b 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -440,38 +440,40 @@ if ($have_nanosleep) { skip 28; } +# Find the loop size N (a for() loop 0..N-1) +# that will take more than T seconds. + if ($have_ualarm && $] >= 5.008001) { # http://groups.google.com/group/perl.perl5.porters/browse_thread/thread/adaffaaf939b042e/20dafc298df737f0%2320dafc298df737f0?sa=X&oi=groupsr&start=0&num=3 # Perl changes [18765] and [18770], perl bug [perl #20920] - # First we will find the loop size N (a for() loop 0..N-1) - # that will take more than T seconds. + print "# Finding delay loop...\n"; my $T = 0.01; use Time::HiRes qw(time); - my $N = 1024; + my $DelayN = 1024; my $i; - N: { - do { - my $t0 = time(); - for ($i = 0; $i < $N; $i++) { } - my $t1 = time(); - my $dt = $t1 - $t0; - print "# N = $N, t1 = $t1, t0 = $t0, dt = $dt\n"; - last N if $dt > $T; - $N *= 2; - } while (1); - } + N: { + do { + my $t0 = time(); + for ($i = 0; $i < $DelayN; $i++) { } + my $t1 = time(); + my $dt = $t1 - $t0; + print "# N = $DelayN, t1 = $t1, t0 = $t0, dt = $dt\n"; + last N if $dt > $T; + $DelayN *= 2; + } while (1); + } - # The time-burner which takes at least T seconds. - my $F = sub { + # The time-burner which takes at least T (default 1) seconds. + my $Delay = sub { my $c = @_ ? shift : 1; - my $n = $c * $N; + my $n = $c * $DelayN; my $i; for ($i = 0; $i < $n; $i++) { } }; - # Then we will setup a periodic timer (the two-argument alarm() of + # Next setup a periodic timer (the two-argument alarm() of # Time::HiRes, behind the curtains the libc ualarm()) which has # a signal handler that takes so much time (on the first initial # invocation) that the first periodic invocation (second invocation) @@ -490,13 +492,13 @@ if ($have_ualarm && $] >= 5.008001) { $a++; print "# Alarm $a - ", time(), "\n"; alarm(0) if $a >= $A; # Disarm the alarm. - $F->(2); # Try burning CPU at least for 2T seconds. + $Delay->(2); # Try burning CPU at least for 2T seconds. }; use Time::HiRes qw(alarm); alarm($T, $T); # Arm the alarm. - $F->(10); # Try burning CPU at least for 10T seconds. + $Delay->(10); # Try burning CPU at least for 10T seconds. print "ok 29\n"; # Not core dumping by now is considered to be the success. } else { @@ -624,39 +626,52 @@ if ($^O =~ /^(cygwin|MSWin)/) { skip 38; } elsif (&Time::HiRes::d_hires_stat) { my @stat; - my @time; + my @atime; + my @mtime; 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]; + push @mtime, $stat[9]; Time::HiRes::sleep(rand(0.1) + 0.1); open(X, "<$$"); ; close(X); @stat = Time::HiRes::stat($$); - push @time, $stat[8]; + push @atime, $stat[8]; } 1 while unlink $$; - print "# @time\n"; - my $mi = 1; + print "# mtime = @mtime\n"; + print "# atime = @atime\n"; + my $ai = 0; + my $mi = 0; my $ss = 0; - for (my $i = 1; $i < @time; $i++) { - if ($time[$i] > $time[$i-1]) { + for (my $i = 1; $i < @atime; $i++) { + if ($atime[$i] >= $atime[$i-1]) { + $ai++; + } + if ($atime[$i] > int($atime[$i])) { + $ss++; + } + } + for (my $i = 1; $i < @mtime; $i++) { + if ($mtime[$i] >= $mtime[$i-1]) { $mi++; } - if ($time[$i] > int($time[$i])) { + if ($mtime[$i] > int($mtime[$i])) { $ss++; } } - # Need at least 80% of monotonical increase and 20% subsecond results. - # Yes, this is shameless guessing of numbers. + print "# ai = $ai, mi = $mi, ss = $ss\n"; + # Need at least 75% of monotonical increase and + # 20% of subsecond results. Yes, this is guessing. if ($ss == 0) { print "# No subsecond timestamps detected\n"; skip 38; - } elsif ($mi/@time > 0.8 && $ss/@time > 0.2) { + } elsif ($mi/(@mtime-1) >= 0.75 && $ai/(@atime-1) >= 0.75 && + $ss/(@mtime+@atime) >= 0.2) { print "ok 38\n"; } else { print "not ok 38\n"; -- 2.7.4