| use strict; |
| |
| BEGIN { |
| require Time::HiRes; |
| unless(&Time::HiRes::d_usleep) { |
| require Test::More; |
| Test::More::plan(skip_all => "no usleep()"); |
| } |
| } |
| |
| use Test::More 0.82 tests => 6; |
| use t::Watchdog; |
| |
| eval { Time::HiRes::usleep(-2) }; |
| like $@, qr/::usleep\(-2\): negative time not invented yet/, |
| "negative time error"; |
| |
| my $limit = 0.25; # 25% is acceptable slosh for testing timers |
| |
| my $one = CORE::time; |
| Time::HiRes::usleep(10_000); |
| my $two = CORE::time; |
| Time::HiRes::usleep(10_000); |
| my $three = CORE::time; |
| ok $one == $two || $two == $three |
| or note "slept too long, $one $two $three"; |
| |
| SKIP: { |
| skip "no gettimeofday", 1 unless &Time::HiRes::d_gettimeofday; |
| my $f = Time::HiRes::time(); |
| Time::HiRes::usleep(500_000); |
| my $f2 = Time::HiRes::time(); |
| my $d = $f2 - $f; |
| ok $d > 0.4 && $d < 0.9 or note "slept $d secs $f to $f2"; |
| } |
| |
| SKIP: { |
| skip "no gettimeofday", 1 unless &Time::HiRes::d_gettimeofday; |
| my $r = [ Time::HiRes::gettimeofday() ]; |
| Time::HiRes::sleep( 0.5 ); |
| my $f = Time::HiRes::tv_interval $r; |
| ok $f > 0.4 && $f < 0.9 or note "slept $f instead of 0.5 secs."; |
| } |
| |
| SKIP: { |
| skip "no gettimeofday", 2 unless &Time::HiRes::d_gettimeofday; |
| |
| my ($t0, $td); |
| |
| my $sleep = 1.5; # seconds |
| my $msg; |
| |
| $t0 = Time::HiRes::gettimeofday(); |
| $a = abs(Time::HiRes::sleep($sleep) / $sleep - 1.0); |
| $td = Time::HiRes::gettimeofday() - $t0; |
| my $ratio = 1.0 + $a; |
| |
| $msg = "$td went by while sleeping $sleep, ratio $ratio.\n"; |
| |
| SKIP: { |
| skip $msg, 1 unless $td < $sleep * (1 + $limit); |
| ok $a < $limit or note $msg; |
| } |
| |
| $t0 = Time::HiRes::gettimeofday(); |
| $a = abs(Time::HiRes::usleep($sleep * 1E6) / ($sleep * 1E6) - 1.0); |
| $td = Time::HiRes::gettimeofday() - $t0; |
| $ratio = 1.0 + $a; |
| |
| $msg = "$td went by while sleeping $sleep, ratio $ratio.\n"; |
| |
| SKIP: { |
| skip $msg, 1 unless $td < $sleep * (1 + $limit); |
| ok $a < $limit or note $msg; |
| } |
| } |
| |
| 1; |