1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
use strict;
sub has_symbol {
my $symbol = shift;
eval "use Time::HiRes qw($symbol)";
return 0 unless $@ eq '';
eval "my \$a = $symbol";
return $@ eq '';
}
use Config;
BEGIN {
require Time::HiRes;
unless(defined &Time::HiRes::setitimer
&& defined &Time::HiRes::getitimer
&& has_symbol('ITIMER_VIRTUAL')
&& $Config{sig_name} =~ m/\bVTALRM\b/
&& $^O ne 'nto' # nto: QNX 6 has the API but no implementation
&& $^O ne 'haiku' # haiku: has the API but no implementation
&& $^O ne 'gnu' # GNU/Hurd: has the API but no implementation
) {
require Test::More;
Test::More::plan(skip_all => "no itimer");
}
}
use Test::More 0.82 tests => 2;
use t::Watchdog;
my $limit = 0.25; # 25% is acceptable slosh for testing timers
my $i = 3;
my $r = [Time::HiRes::gettimeofday()];
$SIG{VTALRM} = sub {
$i ? $i-- : Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0);
note "Tick! $i ", Time::HiRes::tv_interval($r);
};
note "setitimer: ", join(" ",
Time::HiRes::setitimer(&Time::HiRes::ITIMER_VIRTUAL, 0.5, 0.4));
# Assume interval timer granularity of $limit * 0.5 seconds. Too bold?
my $virt = Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL);
ok(defined $virt && abs($virt / 0.5) - 1 < $limit,
"ITIMER_VIRTUAL defined with sufficient granularity")
or diag "virt=" . (defined $virt ? $virt : 'undef');
note "getitimer: ", join(" ",
Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL));
while (Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)) {
my $j;
for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer().
}
note "getitimer: ", join(" ",
Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL));
$virt = Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL);
note "at end, i=$i";
is($virt, 0, "time left should be zero");
$SIG{VTALRM} = 'DEFAULT';
1;
|
