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 while (Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)) {
  55     my $j;
  56     for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer().
  57 }
  58
  59 printf("# getitimer: %s\n", join(" ",
  60        Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL)));
  61
  62 $virt = Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL);
  63 print("# at end, i=$i\n");
  64 is($virt, 0, "time left should be zero");
  65
  66 $SIG{VTALRM} = 'DEFAULT';
  67
  68 1;