diff options
author | Craig A. Berry <craigberry@mac.com> | 2007-11-30 05:05:15 +0000 |
---|---|---|
committer | Craig A. Berry <craigberry@mac.com> | 2007-11-30 05:05:15 +0000 |
commit | 41f5df7a3efb6dbe18c29527be8af2d8b7863eca (patch) | |
tree | 569f180c0c89741080e85f49179814a408f363e2 /ext | |
parent | cd43acd7f6d96351d9ade59be60f84c5989ee3b6 (diff) | |
download | perl-41f5df7a3efb6dbe18c29527be8af2d8b7863eca.tar.gz |
Upgrade to Time::HiRes 1.9711
p4raw-id: //depot/perl@32557
Diffstat (limited to 'ext')
-rw-r--r-- | ext/Time/HiRes/Changes | 6 | ||||
-rw-r--r-- | ext/Time/HiRes/HiRes.pm | 2 | ||||
-rw-r--r-- | ext/Time/HiRes/t/HiRes.t | 88 |
3 files changed, 53 insertions, 43 deletions
diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index d3bc47e526..1a3ba960f8 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,8 +1,12 @@ Revision history for the Perl extension Time::HiRes. +1.9711 [2007-11-29] + - lost VMS test skippage from Craig Berry + - reformat the test code a little + 1.9710 [2007-11-29] - I got the sense of the QNX test the wrong way in an attempt - to generalize it + to generalize it for future 1.9709 [2007-11-28] - casting fixes from Robin Barker for g++ and 64bitint diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index 7d4d22da5b..307ad94a35 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -23,7 +23,7 @@ require DynaLoader; stat ); -$VERSION = '1.9710'; +$VERSION = '1.9711'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index 927df73a27..9410e7df43 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -107,13 +107,13 @@ if (open(XDEFINE, "xdefine")) { # However, if the system is busy, there are no guarantees on how # quickly we will return. This limit used to be 10%, but that # was occasionally triggered falsely. -# Try 25%. +# So let's try 25%. # Another possibility might be to print "ok" if the test completes fine # with (say) 10% slosh, "skip - system may have been busy?" if the test # completes fine with (say) 30% slosh, and fail otherwise. If you do that, # consider changing over to test.pl at the same time. # --A.D., Nov 27, 2001 -my $limit = 0.25; # 20% is acceptable slosh for testing timers +my $limit = 0.25; # 25% is acceptable slosh for testing timers sub skip { map { print "ok $_ # skipped\n" } @_; @@ -267,9 +267,25 @@ unless ( defined &Time::HiRes::gettimeofday if ($use_sigaction) { $oldaction = new POSIX::SigAction; printf "# sigaction tick, ALRM = %d\n", &POSIX::SIGALRM; + # Perl's deferred signals may be too wimpy to break through # a restartable select(), so use POSIX::sigaction if available. - POSIX::sigaction(&POSIX::SIGALRM, POSIX::SigAction->new("tick"), + + sub tick { + $i--; + my $ival = Time::HiRes::tv_interval ($r); + print "# Tick! $i $ival\n"; + my $exp = 0.3 * (5 - $i); + # This test is more sensitive, so impose a softer limit. + if (abs($ival/$exp - 1) > 4*$limit) { + my $ratio = abs($ival/$exp); + $not = "tick: $exp sleep took $ival ratio $ratio"; + $i = 0; + } + } + + POSIX::sigaction(&POSIX::SIGALRM, + POSIX::SigAction->new("tick"), $oldaction) or die "Error setting SIGALRM handler with sigaction: $!\n"; } else { @@ -277,44 +293,34 @@ unless ( defined &Time::HiRes::gettimeofday $SIG{ALRM} = "tick"; } - while ($i > 0) - { - alarm(0.3); - select (undef, undef, undef, 3); - my $ival = Time::HiRes::tv_interval ($r); - print "# Select returned! $i $ival\n"; - print "# ", abs($ival/3 - 1), "\n"; - # Whether select() gets restarted after signals is - # implementation dependent. If it is restarted, we - # will get about 3.3 seconds: 3 from the select, 0.3 - # from the alarm. If this happens, let's just skip - # this particular test. --jhi - if (abs($ival/3.3 - 1) < $limit) { - $ok = "Skip: your select() may get restarted by your SIGALRM (or just retry test)"; - undef $not; - last; - } - my $exp = 0.3 * (5 - $i); - # This test is more sensitive, so impose a softer limit. - if (abs($ival/$exp - 1) > 3*$limit) { - my $ratio = abs($ival/$exp); - $not = "while: $exp sleep took $ival ratio $ratio"; - last; - } - $ok = $i; - } - - sub tick - { - $i--; - my $ival = Time::HiRes::tv_interval ($r); - print "# Tick! $i $ival\n"; - my $exp = 0.3 * (5 - $i); - # This test is more sensitive, so impose a softer limit. - if (abs($ival/$exp - 1) > 4*$limit) { - my $ratio = abs($ival/$exp); - $not = "tick: $exp sleep took $ival ratio $ratio"; - $i = 0; + # On VMS timers can not interrupt select. + if ($^O eq 'VMS') { + $ok = "Skip: VMS select() does not get interrupted."; + } else { + while ($i > 0) { + alarm(0.3); + select (undef, undef, undef, 3); + my $ival = Time::HiRes::tv_interval ($r); + print "# Select returned! $i $ival\n"; + print "# ", abs($ival/3 - 1), "\n"; + # Whether select() gets restarted after signals is + # implementation dependent. If it is restarted, we + # will get about 3.3 seconds: 3 from the select, 0.3 + # from the alarm. If this happens, let's just skip + # this particular test. --jhi + if (abs($ival/3.3 - 1) < $limit) { + $ok = "Skip: your select() may get restarted by your SIGALRM (or just retry test)"; + undef $not; + last; + } + my $exp = 0.3 * (5 - $i); + # This test is more sensitive, so impose a softer limit. + if (abs($ival/$exp - 1) > 3*$limit) { + my $ratio = abs($ival/$exp); + $not = "while: $exp sleep took $ival ratio $ratio"; + last; + } + $ok = $i; } } |