dist/Time-HiRes/t/ualarm.t

   1 use strict;
   2
   3 BEGIN {
   4     require Time::HiRes;
   5     unless(&Time::HiRes::d_ualarm) {
   6         require Test::More;
   7         Test::More::plan(skip_all => "no ualarm()");
   8     }
   9 }
  10
  11 use Test::More tests => 12;
  12 BEGIN { push @INC, '.' }
  13 use t::Watchdog;
  14
  15 use Config;
  16
  17 SKIP: {
  18     skip "no alarm", 2 unless $Config{d_alarm};
  19     my $tick = 0;
  20     local $SIG{ ALRM } = sub { $tick++ };
  21
  22     my $one = CORE::time;
  23     $tick = 0; Time::HiRes::ualarm(10_000); while ($tick == 0) { }
  24     my $two = CORE::time;
  25     $tick = 0; Time::HiRes::ualarm(10_000); while ($tick == 0) { }
  26     my $three = CORE::time;
  27     ok $one == $two || $two == $three
  28         or print("# slept too long, $one $two $three\n");
  29     print("# tick = $tick, one = $one, two = $two, three = $three\n");
  30
  31     $tick = 0; Time::HiRes::ualarm(10_000, 10_000); while ($tick < 3) { }
  32     ok 1;
  33     Time::HiRes::ualarm(0);
  34     print("# tick = $tick, one = $one, two = $two, three = $three\n");
  35 }
  36
  37 eval { Time::HiRes::ualarm(-4) };
  38 like $@, qr/::ualarm\(-4, 0\): negative time not invented yet/,
  39         "negative time error";
  40
  41 # Find the loop size N (a for() loop 0..N-1)
  42 # that will take more than T seconds.
  43
  44 sub bellish {  # Cheap emulation of a bell curve.
  45     my ($min, $max) = @_;
  46     my $rand = ($max - $min) / 5;
  47     my $sum = 0;
  48     for my $i (0..4) {
  49         $sum += rand($rand);
  50     }
  51     return $min + $sum;
  52 }
  53
  54 # 1_100_000 slightly over 1_000_000,
  55 # 2_200_000 slightly over 2**31/1000,
  56 # 4_300_000 slightly over 2**32/1000.
  57 for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) {
  58     my $ok;
  59     for my $retry (1..10) {
  60         my $alarmed = 0;
  61         local $SIG{ ALRM } = sub { $alarmed++ };
  62         my $t0 = Time::HiRes::time();
  63         print("# t0 = $t0\n");
  64         print("# ualarm($n)\n");
  65         Time::HiRes::ualarm($n); 1 while $alarmed == 0;
  66         my $t1 = Time::HiRes::time();
  67         print("# t1 = $t1\n");
  68         my $dt = $t1 - $t0;
  69         print("# dt = $dt\n");
  70         my $r = $dt / ($n/1e6);
  71         print("# r = $r\n");
  72         $ok =
  73             ($n < 1_000_000 || # Too much noise.
  74              ($r >= 0.8 && $r <= 1.6));
  75         last if $ok;
  76         my $nap = bellish(3, 15);
  77         printf("# Retrying in %.1f seconds...\n", $nap);
  78         Time::HiRes::sleep($nap);
  79     }
  80     ok $ok or print("# ualarm($n) close enough\n");
  81 }
  82
  83 {
  84     my $alrm0 = 0;
  85
  86     $SIG{ALRM} = sub { $alrm0++ };
  87     my $t0 = Time::HiRes::time();
  88     my $got0 = Time::HiRes::ualarm(500_000);
  89
  90     my($alrm, $t1);
  91     do {
  92         $alrm = $alrm0;
  93         $t1 = Time::HiRes::time();
  94     } while $t1 - $t0 <= 0.3;
  95     my $got1 = Time::HiRes::ualarm(0);
  96
  97     print("# t0 = $t0\n");
  98     print("# got0 = $got0\n");
  99     print("# t1 = $t1\n");
 100     printf("# t1 - t0 = %s\n", ($t1 - $t0));
 101     print("# got1 = $got1\n");
 102     ok $got0 == 0 or print("# $got0\n");
 103     SKIP: {
 104         skip "alarm interval exceeded", 2 if $t1 - $t0 >= 0.5;
 105         ok $got1 > 0;
 106         ok $alrm == 0;
 107     }
 108     ok $got1 < 300_000;
 109     my $got2 = Time::HiRes::ualarm(0);
 110     ok $got2 == 0 or print("# $got2\n");
 111 }
 112
 113 1;