ext/Time/HiRes/t/HiRes.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     if ($ENV{PERL_CORE}) {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7         require Config; import Config;
   8         if (" $Config{'extensions'} " !~ m[ Time/HiRes ]) {
   9             print "1..0 # Skip -- Perl configured without Time::HiRes module\n";
  10             exit 0;
  11         }
  12     }
  13 }
  14
  15 BEGIN { $| = 1; print "1..40\n"; }
  16
  17 END { print "not ok 1\n" unless $loaded }
  18
  19 use Time::HiRes 1.9704; # Remember to bump this once in a while.
  20 use Time::HiRes qw(tv_interval);
  21
  22 $loaded = 1;
  23
  24 print "ok 1\n";
  25
  26 use strict;
  27
  28 my $have_gettimeofday    = &Time::HiRes::d_gettimeofday;
  29 my $have_usleep          = &Time::HiRes::d_usleep;
  30 my $have_nanosleep       = &Time::HiRes::d_nanosleep;
  31 my $have_ualarm          = &Time::HiRes::d_ualarm;
  32 my $have_clock_gettime   = &Time::HiRes::d_clock_gettime;
  33 my $have_clock_getres    = &Time::HiRes::d_clock_getres;
  34 my $have_clock_nanosleep = &Time::HiRes::d_clock_nanosleep;
  35 my $have_clock           = &Time::HiRes::d_clock;
  36 my $have_hires_stat      = &Time::HiRes::d_hires_stat;
  37
  38 sub has_symbol {
  39     my $symbol = shift;
  40     eval "use Time::HiRes qw($symbol)";
  41     return 0 unless $@ eq '';
  42     eval "my \$a = $symbol";
  43     return $@ eq '';
  44 }
  45
  46 printf "# have_gettimeofday    = %d\n", $have_gettimeofday;
  47 printf "# have_usleep          = %d\n", $have_usleep;
  48 printf "# have_nanosleep       = %d\n", $have_nanosleep;
  49 printf "# have_ualarm          = %d\n", $have_ualarm;
  50 printf "# have_clock_gettime   = %d\n", $have_clock_gettime;
  51 printf "# have_clock_getres    = %d\n", $have_clock_getres;
  52 printf "# have_clock_nanosleep = %d\n", $have_clock_nanosleep;
  53 printf "# have_clock           = %d\n", $have_clock;
  54 printf "# have_hires_stat      = %d\n", $have_hires_stat;
  55
  56 import Time::HiRes 'gettimeofday'       if $have_gettimeofday;
  57 import Time::HiRes 'usleep'             if $have_usleep;
  58 import Time::HiRes 'nanosleep'          if $have_nanosleep;
  59 import Time::HiRes 'ualarm'             if $have_ualarm;
  60 import Time::HiRes 'clock_gettime'      if $have_clock_gettime;
  61 import Time::HiRes 'clock_getres'       if $have_clock_getres;
  62 import Time::HiRes 'clock_nanosleep'    if $have_clock_nanosleep;
  63 import Time::HiRes 'clock'              if $have_clock;
  64
  65 use Config;
  66
  67 use Time::HiRes qw(gettimeofday);
  68
  69 my $have_alarm = $Config{d_alarm};
  70 my $have_fork  = $Config{d_fork};
  71 my $waitfor = 360; # 30-45 seconds is normal (load affects this).
  72 my $timer_pid;
  73 my $TheEnd;
  74
  75 if ($have_fork) {
  76     print "# I am the main process $$, starting the timer process...\n";
  77     $timer_pid = fork();
  78     if (defined $timer_pid) {
  79         if ($timer_pid == 0) { # We are the kid, set up the timer.
  80             my $ppid = getppid();
  81             print "# I am the timer process $$, sleeping for $waitfor seconds...\n";
  82             sleep($waitfor - 2);    # Workaround for perlbug #49073
  83             sleep(2);               # Wait for parent to exit
  84             if (kill(0, $ppid)) {   # Check if parent still exists
  85                 warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n";
  86                 print "# Terminating main process $ppid...\n";
  87                 kill('KILL', $ppid);
  88                 print "# This is the timer process $$, over and out.\n";
  89             }
  90             exit(0);
  91         } else {
  92             print "# The timer process $timer_pid launched, continuing testing...\n";
  93             $TheEnd = time() + $waitfor;
  94         }
  95     } else {
  96         warn "$0: fork failed: $!\n";
  97     }
  98 } else {
  99     print "# No timer process (need fork)\n";
 100 }
 101
 102 my $xdefine = '';
 103
 104 if (open(XDEFINE, "xdefine")) {
 105     chomp($xdefine = <XDEFINE>);
 106     close(XDEFINE);
 107 }
 108
 109 # Ideally, we'd like to test that the timers are rather precise.
 110 # However, if the system is busy, there are no guarantees on how
 111 # quickly we will return.  This limit used to be 10%, but that
 112 # was occasionally triggered falsely.
 113 # So let's try 25%.
 114 # Another possibility might be to print "ok" if the test completes fine
 115 # with (say) 10% slosh, "skip - system may have been busy?" if the test
 116 # completes fine with (say) 30% slosh, and fail otherwise.  If you do that,
 117 # consider changing over to test.pl at the same time.
 118 # --A.D., Nov 27, 2001
 119 my $limit = 0.25; # 25% is acceptable slosh for testing timers
 120
 121 sub skip {
 122     map { print "ok $_ # skipped\n" } @_;
 123 }
 124
 125 sub ok {
 126     my ($n, $result, @info) = @_;
 127     if ($result) {
 128         print "ok $n\n";
 129     }
 130     else {
 131         print "not ok $n\n";
 132         print "# @info\n" if @info;
 133     }
 134 }
 135
 136 unless ($have_gettimeofday) {
 137     skip 2..6;
 138 }
 139 else {
 140     my @one = gettimeofday();
 141     ok 2, @one == 2, 'gettimeofday returned ', 0+@one, ' args';
 142     ok 3, $one[0] > 850_000_000, "@one too small";
 143
 144     sleep 1;
 145
 146     my @two = gettimeofday();
 147     ok 4, ($two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1])),
 148             "@two is not greater than @one";
 149
 150     my $f = Time::HiRes::time();
 151     ok 5, $f > 850_000_000, "$f too small";
 152     ok 6, $f - $two[0] < 2, "$f - $two[0] >= 2";
 153 }
 154
 155 unless ($have_usleep) {
 156     skip 7..8;
 157 }
 158 else {
 159     use Time::HiRes qw(usleep);
 160     my $one = time;
 161     usleep(10_000);
 162     my $two = time;
 163     usleep(10_000);
 164     my $three = time;
 165     ok 7, $one == $two || $two == $three, "slept too long, $one $two $three";
 166
 167     unless ($have_gettimeofday) {
 168         skip 8;
 169     }
 170     else {
 171         my $f = Time::HiRes::time();
 172         usleep(500_000);
 173         my $f2 = Time::HiRes::time();
 174         my $d = $f2 - $f;
 175         ok 8, $d > 0.4 && $d < 0.9, "slept $d secs $f to $f2";
 176     }
 177 }
 178
 179 # Two-arg tv_interval() is always available.
 180 {
 181     my $f = tv_interval [5, 100_000], [10, 500_000];
 182     ok 9, abs($f - 5.4) < 0.001, $f;
 183 }
 184
 185 unless ($have_gettimeofday) {
 186     skip 10;
 187 }
 188 else {
 189     my $r = [gettimeofday()];
 190     my $f = tv_interval $r;
 191     ok 10, $f < 2, $f;
 192 }
 193
 194 unless ($have_usleep && $have_gettimeofday) {
 195     skip 11;
 196 }
 197 else {
 198     my $r = [ gettimeofday() ];
 199     Time::HiRes::sleep( 0.5 );
 200     my $f = tv_interval $r;
 201     ok 11, $f > 0.4 && $f < 0.9, "slept $f instead of 0.5 secs.";
 202 }
 203
 204 unless ($have_ualarm && $have_alarm) {
 205     skip 12..13;
 206 }
 207 else {
 208     my $tick = 0;
 209     local $SIG{ ALRM } = sub { $tick++ };
 210
 211     my $one = time; $tick = 0; ualarm(10_000); while ($tick == 0) { }
 212     my $two = time; $tick = 0; ualarm(10_000); while ($tick == 0) { }
 213     my $three = time;
 214     ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
 215     print "# tick = $tick, one = $one, two = $two, three = $three\n";
 216
 217     $tick = 0; ualarm(10_000, 10_000); while ($tick < 3) { }
 218     ok 13, 1;
 219     ualarm(0);
 220     print "# tick = $tick, one = $one, two = $two, three = $three\n";
 221 }
 222
 223 # Did we even get close?
 224
 225 unless ($have_gettimeofday) {
 226     skip 14;
 227 } else {
 228  my ($s, $n, $i) = (0);
 229  for $i (1 .. 100) {
 230      $s += Time::HiRes::time() - time();
 231      $n++;
 232  }
 233  # $s should be, at worst, equal to $n
 234  # (time() may be rounding down, up, or closest),
 235  # but allow 10% of slop.
 236  ok 14, abs($s) / $n <= 1.10, "Time::HiRes::time() not close to time()";
 237  print "# s = $s, n = $n, s/n = ", abs($s)/$n, "\n";
 238 }
 239
 240 my $has_ualarm = $Config{d_ualarm};
 241
 242 $has_ualarm ||= $xdefine =~ /-DHAS_UALARM/;
 243
 244 my $can_subsecond_alarm =
 245    defined &Time::HiRes::gettimeofday &&
 246    defined &Time::HiRes::ualarm &&
 247    defined &Time::HiRes::usleep &&
 248    $has_ualarm;
 249
 250 unless ($can_subsecond_alarm) {
 251     for (15..17) {
 252         print "ok $_ # Skip: no gettimeofday or no ualarm or no usleep\n";
 253     }
 254 } else {
 255     use Time::HiRes qw(time alarm sleep);
 256     eval { require POSIX };
 257     my $use_sigaction =
 258         !$@ && defined &POSIX::sigaction && &POSIX::SIGALRM > 0;
 259
 260     my ($f, $r, $i, $not, $ok);
 261
 262     $f = time;
 263     print "# time...$f\n";
 264     print "ok 15\n";
 265
 266     $r = [Time::HiRes::gettimeofday()];
 267     sleep (0.5);
 268     print "# sleep...", Time::HiRes::tv_interval($r), "\nok 16\n";
 269
 270     $r = [Time::HiRes::gettimeofday()];
 271     $i = 5;
 272     my $oldaction;
 273     if ($use_sigaction) {
 274         $oldaction = new POSIX::SigAction;
 275         printf "# sigaction tick, ALRM = %d\n", &POSIX::SIGALRM;
 276
 277         # Perl's deferred signals may be too wimpy to break through
 278         # a restartable select(), so use POSIX::sigaction if available.
 279
 280         POSIX::sigaction(&POSIX::SIGALRM,
 281                          POSIX::SigAction->new("tick"),
 282                          $oldaction)
 283             or die "Error setting SIGALRM handler with sigaction: $!\n";
 284     } else {
 285         print "# SIG tick\n";
 286         $SIG{ALRM} = "tick";
 287     }
 288
 289     # On VMS timers can not interrupt select.
 290     if ($^O eq 'VMS') {
 291         $ok = "Skip: VMS select() does not get interrupted.";
 292     } else {
 293         while ($i > 0) {
 294             alarm(0.3);
 295             select (undef, undef, undef, 3);
 296             my $ival = Time::HiRes::tv_interval ($r);
 297             print "# Select returned! $i $ival\n";
 298             print "# ", abs($ival/3 - 1), "\n";
 299             # Whether select() gets restarted after signals is
 300             # implementation dependent.  If it is restarted, we
 301             # will get about 3.3 seconds: 3 from the select, 0.3
 302             # from the alarm.  If this happens, let's just skip
 303             # this particular test.  --jhi
 304             if (abs($ival/3.3 - 1) < $limit) {
 305                 $ok = "Skip: your select() may get restarted by your SIGALRM (or just retry test)";
 306                 undef $not;
 307                 last;
 308             }
 309             my $exp = 0.3 * (5 - $i);
 310             if ($exp == 0) {
 311                 $not = "while: divisor became zero";
 312                 last;
 313             }
 314             # This test is more sensitive, so impose a softer limit.
 315             if (abs($ival/$exp - 1) > 4*$limit) {
 316                 my $ratio = abs($ival/$exp);
 317                 $not = "while: $exp sleep took $ival ratio $ratio";
 318                 last;
 319             }
 320             $ok = $i;
 321         }
 322     }
 323
 324     sub tick {
 325         $i--;
 326         my $ival = Time::HiRes::tv_interval ($r);
 327         print "# Tick! $i $ival\n";
 328         my $exp = 0.3 * (5 - $i);
 329         if ($exp == 0) {
 330             $not = "tick: divisor became zero";
 331             last;
 332         }
 333         # This test is more sensitive, so impose a softer limit.
 334         if (abs($ival/$exp - 1) > 4*$limit) {
 335             my $ratio = abs($ival/$exp);
 336             $not = "tick: $exp sleep took $ival ratio $ratio";
 337             $i = 0;
 338         }
 339     }
 340
 341     if ($use_sigaction) {
 342         POSIX::sigaction(&POSIX::SIGALRM, $oldaction);
 343     } else {
 344         alarm(0); # can't cancel usig %SIG
 345     }
 346
 347     print $not ? "not ok 17 # $not\n" : "ok 17 # $ok\n";
 348 }
 349
 350 unless (defined &Time::HiRes::setitimer
 351         && defined &Time::HiRes::getitimer
 352         && has_symbol('ITIMER_VIRTUAL')
 353         && $Config{sig_name} =~ m/\bVTALRM\b/
 354         && $^O ne 'nto' # nto: QNX 6 has the API but no implementation
 355         && $^O ne 'haiku' # haiku: has the API but no implementation
 356     ) {
 357     for (18..19) {
 358         print "ok $_ # Skip: no virtual interval timers\n";
 359     }
 360 } else {
 361     use Time::HiRes qw(setitimer getitimer ITIMER_VIRTUAL);
 362
 363     my $i = 3;
 364     my $r = [Time::HiRes::gettimeofday()];
 365
 366     $SIG{VTALRM} = sub {
 367         $i ? $i-- : setitimer(&ITIMER_VIRTUAL, 0);
 368         print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n";
 369     };
 370
 371     print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 0.5, 0.4)), "\n";
 372
 373     # Assume interval timer granularity of $limit * 0.5 seconds.  Too bold?
 374     my $virt = getitimer(&ITIMER_VIRTUAL);
 375     print "not " unless defined $virt && abs($virt / 0.5) - 1 < $limit;
 376     print "ok 18\n";
 377
 378     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
 379
 380     while (getitimer(&ITIMER_VIRTUAL)) {
 381         my $j;
 382         for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer().
 383     }
 384
 385     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
 386
 387     $virt = getitimer(&ITIMER_VIRTUAL);
 388     print "not " unless defined $virt && $virt == 0;
 389     print "ok 19\n";
 390
 391     $SIG{VTALRM} = 'DEFAULT';
 392 }
 393
 394 if ($have_gettimeofday &&
 395     $have_usleep) {
 396     use Time::HiRes qw(usleep);
 397
 398     my ($t0, $td);
 399
 400     my $sleep = 1.5; # seconds
 401     my $msg;
 402
 403     $t0 = gettimeofday();
 404     $a = abs(sleep($sleep)        / $sleep         - 1.0);
 405     $td = gettimeofday() - $t0;
 406     my $ratio = 1.0 + $a;
 407
 408     $msg = "$td went by while sleeping $sleep, ratio $ratio.\n";
 409
 410     if ($td < $sleep * (1 + $limit)) {
 411         print $a < $limit ? "ok 20 # $msg" : "not ok 20 # $msg";
 412     } else {
 413         print "ok 20 # Skip: $msg";
 414     }
 415
 416     $t0 = gettimeofday();
 417     $a = abs(usleep($sleep * 1E6) / ($sleep * 1E6) - 1.0);
 418     $td = gettimeofday() - $t0;
 419     $ratio = 1.0 + $a;
 420
 421     $msg = "$td went by while sleeping $sleep, ratio $ratio.\n";
 422
 423     if ($td < $sleep * (1 + $limit)) {
 424         print $a < $limit ? "ok 21 # $msg" : "not ok 21 # $msg";
 425     } else {
 426         print "ok 21 # Skip: $msg";
 427     }
 428
 429 } else {
 430     for (20..21) {
 431         print "ok $_ # Skip: no gettimeofday\n";
 432     }
 433 }
 434
 435 unless ($have_nanosleep) {
 436     skip 22..23;
 437 }
 438 else {
 439     my $one = CORE::time;
 440     nanosleep(10_000_000);
 441     my $two = CORE::time;
 442     nanosleep(10_000_000);
 443     my $three = CORE::time;
 444     ok 22, $one == $two || $two == $three, "slept too long, $one $two $three";
 445
 446     unless ($have_gettimeofday) {
 447         skip 23;
 448     }
 449     else {
 450         my $f = Time::HiRes::time();
 451         nanosleep(500_000_000);
 452         my $f2 = Time::HiRes::time();
 453         my $d = $f2 - $f;
 454         ok 23, $d > 0.4 && $d < 0.9, "slept $d secs $f to $f2";
 455     }
 456 }
 457
 458 eval { sleep(-1) };
 459 print $@ =~ /::sleep\(-1\): negative time not invented yet/ ?
 460     "ok 24\n" : "not ok 24\n";
 461
 462 eval { usleep(-2) };
 463 print $@ =~ /::usleep\(-2\): negative time not invented yet/ ?
 464     "ok 25\n" : "not ok 25\n";
 465
 466 if ($have_ualarm) {
 467     eval { alarm(-3) };
 468     print $@ =~ /::alarm\(-3, 0\): negative time not invented yet/ ?
 469         "ok 26\n" : "not ok 26\n";
 470
 471     eval { ualarm(-4) };
 472     print $@ =~ /::ualarm\(-4, 0\): negative time not invented yet/ ?
 473     "ok 27\n" : "not ok 27\n";
 474 } else {
 475     skip 26;
 476     skip 27;
 477 }
 478
 479 if ($have_nanosleep) {
 480     eval { nanosleep(-5) };
 481     print $@ =~ /::nanosleep\(-5\): negative time not invented yet/ ?
 482         "ok 28\n" : "not ok 28\n";
 483 } else {
 484     skip 28;
 485 }
 486
 487 # Find the loop size N (a for() loop 0..N-1)
 488 # that will take more than T seconds.
 489
 490 if ($have_ualarm && $] >= 5.008001) {
 491     # http://groups.google.com/group/perl.perl5.porters/browse_thread/thread/adaffaaf939b042e/20dafc298df737f0%2320dafc298df737f0?sa=X&oi=groupsr&start=0&num=3
 492     # Perl changes [18765] and [18770], perl bug [perl #20920]
 493
 494     print "# Finding delay loop...\n";
 495
 496     my $T = 0.01;
 497     use Time::HiRes qw(time);
 498     my $DelayN = 1024;
 499     my $i;
 500  N: {
 501      do {
 502          my $t0 = time();
 503          for ($i = 0; $i < $DelayN; $i++) { }
 504          my $t1 = time();
 505          my $dt = $t1 - $t0;
 506          print "# N = $DelayN, t1 = $t1, t0 = $t0, dt = $dt\n";
 507          last N if $dt > $T;
 508          $DelayN *= 2;
 509      } while (1);
 510  }
 511
 512     # The time-burner which takes at least T (default 1) seconds.
 513     my $Delay = sub {
 514         my $c = @_ ? shift : 1;
 515         my $n = $c * $DelayN;
 516         my $i;
 517         for ($i = 0; $i < $n; $i++) { }
 518     };
 519
 520     # Next setup a periodic timer (the two-argument alarm() of
 521     # Time::HiRes, behind the curtains the libc getitimer() or
 522     # ualarm()) which has a signal handler that takes so much time (on
 523     # the first initial invocation) that the first periodic invocation
 524     # (second invocation) will happen before the first invocation has
 525     # finished.  In Perl 5.8.0 the "safe signals" concept was
 526     # implemented, with unfortunately at least one bug that caused a
 527     # core dump on reentering the handler. This bug was fixed by the
 528     # time of Perl 5.8.1.
 529
 530     # Do not try mixing sleep() and alarm() for testing this.
 531
 532     my $a = 0; # Number of alarms we receive.
 533     my $A = 2; # Number of alarms we will handle before disarming.
 534                # (We may well get $A + 1 alarms.)
 535
 536     $SIG{ALRM} = sub {
 537         $a++;
 538         print "# Alarm $a - ", time(), "\n";
 539         alarm(0) if $a >= $A; # Disarm the alarm.
 540         $Delay->(2); # Try burning CPU at least for 2T seconds.
 541     };
 542
 543     use Time::HiRes qw(alarm);
 544     alarm($T, $T);  # Arm the alarm.
 545
 546     $Delay->(10); # Try burning CPU at least for 10T seconds.
 547
 548     print "ok 29\n"; # Not core dumping by now is considered to be the success.
 549 } else {
 550     skip 29;
 551 }
 552
 553 if ($have_clock_gettime &&
 554     # All implementations of clock_gettime()
 555     # are SUPPOSED TO support CLOCK_REALTIME.
 556     has_symbol('CLOCK_REALTIME')) {
 557     my $ok = 0;
 558  TRY: {
 559         for my $try (1..3) {
 560             print "# CLOCK_REALTIME: try = $try\n";
 561             my $t0 = clock_gettime(&CLOCK_REALTIME);
 562             use Time::HiRes qw(sleep);
 563             my $T = 1.5;
 564             sleep($T);
 565             my $t1 = clock_gettime(&CLOCK_REALTIME);
 566             if ($t0 > 0 && $t1 > $t0) {
 567                 print "# t1 = $t1, t0 = $t0\n";
 568                 my $dt = $t1 - $t0;
 569                 my $rt = abs(1 - $dt / $T);
 570                 print "# dt = $dt, rt = $rt\n";
 571                 if ($rt <= 2 * $limit) {
 572                     $ok = 1;
 573                     last TRY;
 574                 }
 575             } else {
 576                 print "# Error: t0 = $t0, t1 = $t1\n";
 577             }
 578             my $r = rand() + rand();
 579             printf "# Sleeping for %.6f seconds...\n", $r;
 580             sleep($r);
 581         }
 582     }
 583     if ($ok) {
 584         print "ok 30\n";
 585     } else {
 586         print "not ok 30\n";
 587     }
 588 } else {
 589     print "# No clock_gettime\n";
 590     skip 30;
 591 }
 592
 593 if ($have_clock_getres) {
 594     my $tr = clock_getres();
 595     if ($tr > 0) {
 596         print "ok 31 # tr = $tr\n";
 597     } else {
 598         print "not ok 31 # tr = $tr\n";
 599     }
 600 } else {
 601     print "# No clock_getres\n";
 602     skip 31;
 603 }
 604
 605 if ($have_clock_nanosleep &&
 606     has_symbol('CLOCK_REALTIME')) {
 607     my $s = 1.5e9;
 608     my $t = clock_nanosleep(&CLOCK_REALTIME, $s);
 609     my $r = abs(1 - $t / $s);
 610     if ($r < 2 * $limit) {
 611         print "ok 32\n";
 612     } else {
 613         print "not ok 32 # $t = $t, r = $r\n";
 614     }
 615 } else {
 616     print "# No clock_nanosleep\n";
 617     skip 32;
 618 }
 619
 620 if ($have_clock) {
 621     my @clock = clock();
 622     print "# clock = @clock\n";
 623     for my $i (1..3) {
 624         for (my $j = 0; $j < 1e6; $j++) { }
 625         push @clock, clock();
 626         print "# clock = @clock\n";
 627     }
 628     if ($clock[0] >= 0 &&
 629         $clock[1] > $clock[0] &&
 630         $clock[2] > $clock[1] &&
 631         $clock[3] > $clock[2]) {
 632         print "ok 33\n";
 633     } else {
 634         print "not ok 33\n";
 635     }
 636 } else {
 637     skip 33;
 638 }
 639
 640 sub bellish {  # Cheap emulation of a bell curve.
 641     my ($min, $max) = @_;
 642     my $rand = ($max - $min) / 5;
 643     my $sum = 0;
 644     for my $i (0..4) {
 645         $sum += rand($rand);
 646     }
 647     return $min + $sum;
 648 }
 649
 650 if ($have_ualarm) {
 651     # 1_100_000 sligthly over 1_000_000,
 652     # 2_200_000 slightly over 2**31/1000,
 653     # 4_300_000 slightly over 2**32/1000.
 654     for my $t ([34, 100_000],
 655                [35, 1_100_000],
 656                [36, 2_200_000],
 657                [37, 4_300_000]) {
 658         my ($i, $n) = @$t;
 659         my $ok;
 660         for my $retry (1..10) {
 661             my $alarmed = 0;
 662             local $SIG{ ALRM } = sub { $alarmed++ };
 663             my $t0 = Time::HiRes::time();
 664             print "# t0 = $t0\n";
 665             print "# ualarm($n)\n";
 666             ualarm($n); 1 while $alarmed == 0;
 667             my $t1 = Time::HiRes::time();
 668             print "# t1 = $t1\n";
 669             my $dt = $t1 - $t0;
 670             print "# dt = $dt\n";
 671             my $r = $dt / ($n/1e6);
 672             print "# r = $r\n";
 673             $ok =
 674                 ($n < 1_000_000 || # Too much noise.
 675                  ($r >= 0.8 && $r <= 1.6));
 676             last if $ok;
 677             my $nap = bellish(3, 15);
 678             printf "# Retrying in %.1f seconds...\n", $nap;
 679             Time::HiRes::sleep($nap);
 680         }
 681         ok $i, $ok, "ualarm($n) close enough";
 682     }
 683 } else {
 684     print "# No ualarm\n";
 685     skip 34..37;
 686 }
 687
 688 if ($^O =~ /^(cygwin|MSWin)/) {
 689     print "# $^O: timestamps may not be good enough\n";
 690     skip 38;
 691 } elsif (&Time::HiRes::d_hires_stat) {
 692     my @stat;
 693     my @atime;
 694     my @mtime;
 695     for (1..5) {
 696         Time::HiRes::sleep(rand(0.1) + 0.1);
 697         open(X, ">$$");
 698         print X $$;
 699         close(X);
 700         @stat = Time::HiRes::stat($$);
 701         push @mtime, $stat[9];
 702         Time::HiRes::sleep(rand(0.1) + 0.1);
 703         open(X, "<$$");
 704         <X>;
 705         close(X);
 706         @stat = Time::HiRes::stat($$);
 707         push @atime, $stat[8];
 708     }
 709     1 while unlink $$;
 710     print "# mtime = @mtime\n";
 711     print "# atime = @atime\n";
 712     my $ai = 0;
 713     my $mi = 0;
 714     my $ss = 0;
 715     for (my $i = 1; $i < @atime; $i++) {
 716         if ($atime[$i] >= $atime[$i-1]) {
 717             $ai++;
 718         }
 719         if ($atime[$i] > int($atime[$i])) {
 720             $ss++;
 721         }
 722     }
 723     for (my $i = 1; $i < @mtime; $i++) {
 724         if ($mtime[$i] >= $mtime[$i-1]) {
 725             $mi++;
 726         }
 727         if ($mtime[$i] > int($mtime[$i])) {
 728             $ss++;
 729         }
 730     }
 731     print "# ai = $ai, mi = $mi, ss = $ss\n";
 732     # Need at least 75% of monotonical increase and
 733     # 20% of subsecond results. Yes, this is guessing.
 734     if ($ss == 0) {
 735         print "# No subsecond timestamps detected\n";
 736         skip 38;
 737     } elsif ($mi/(@mtime-1) >= 0.75 && $ai/(@atime-1) >= 0.75 &&
 738              $ss/(@mtime+@atime) >= 0.2) {
 739         print "ok 38\n";
 740     } else {
 741         print "not ok 38\n";
 742     }
 743 } else {
 744     print "# No effectual d_hires_stat\n";
 745     skip 38;
 746 }
 747
 748 unless ($can_subsecond_alarm) {
 749     skip 39..40;
 750 } else {
 751     {
 752         my $alrm;
 753         $SIG{ALRM} = sub { $alrm++ };
 754         Time::HiRes::alarm(0.1);
 755         my $t0 = time();
 756         1 while time() - $t0 <= 1;
 757         print $alrm ? "ok 39\n" : "not ok 39\n";
 758     }
 759     {
 760         my $alrm;
 761         $SIG{ALRM} = sub { $alrm++ };
 762         Time::HiRes::alarm(1.1);
 763         my $t0 = time();
 764         1 while time() - $t0 <= 2;
 765         print $alrm ? "ok 40\n" : "not ok 40\n";
 766     }
 767 }
 768
 769 END {
 770     if ($timer_pid) { # Only in the main process.
 771         my $left = $TheEnd - time();
 772         printf "# I am the main process $$, terminating the timer process $timer_pid\n# before it terminates me in %d seconds (testing took %d seconds).\n", $left, $waitfor - $left;
 773         if (kill(0, $timer_pid)) {
 774             local $? = 0;
 775             my $kill = kill('KILL', $timer_pid); # We are done, the timer can go.
 776             wait();
 777             printf "# kill KILL $timer_pid = %d\n", $kill;
 778         }
 779         unlink("ktrace.out"); # Used in BSD system call tracing.
 780         print "# All done.\n";
 781     }
 782 }
 783