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