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..25\n"; }
  16
  17 END {print "not ok 1\n" unless $loaded;}
  18
  19 use Time::HiRes qw(tv_interval);
  20
  21 $loaded = 1;
  22
  23 print "ok 1\n";
  24
  25 use strict;
  26
  27 my $have_gettimeofday   = defined &Time::HiRes::gettimeofday;
  28 my $have_usleep         = defined &Time::HiRes::usleep;
  29 my $have_ualarm         = defined &Time::HiRes::ualarm;
  30 my $have_time           = defined &Time::HiRes::time;
  31
  32 import Time::HiRes 'gettimeofday'       if $have_gettimeofday;
  33 import Time::HiRes 'usleep'             if $have_usleep;
  34 import Time::HiRes 'ualarm'             if $have_ualarm;
  35
  36 use Config;
  37
  38 my $have_alarm = $Config{d_alarm};
  39 my $have_fork  = $Config{d_fork};
  40 my $waitfor = 60; # 10 seconds is normal.
  41 my $pid;
  42
  43 if ($have_fork) {
  44     print "# Testing process $$\n";
  45     print "# Starting the timer process\n";
  46     if (defined ($pid = fork())) {
  47         if ($pid == 0) { # We are the kid, set up the timer.
  48             print "# Timer process $$\n";
  49             sleep($waitfor);
  50             warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded\n";
  51             print "# Terminating the testing process\n";
  52             kill('TERM', getppid());
  53             print "# Timer process exiting\n";
  54             exit(0);
  55         }
  56     } else {
  57         warn "$0: fork failed: $!\n";
  58     }
  59 } else {
  60     print "# No timer process\n";
  61 }
  62
  63 my $xdefine = '';
  64
  65 if (open(XDEFINE, "xdefine")) {
  66     chomp($xdefine = <XDEFINE>);
  67     close(XDEFINE);
  68 }
  69
  70 # Ideally, we'd like to test that the timers are rather precise.
  71 # However, if the system is busy, there are no guarantees on how
  72 # quickly we will return.  This limit used to be 10%, but that
  73 # was occasionally triggered falsely.
  74 # Try 20%.
  75 # Another possibility might be to print "ok" if the test completes fine
  76 # with (say) 10% slosh, "skip - system may have been busy?" if the test
  77 # completes fine with (say) 30% slosh, and fail otherwise.  If you do that,
  78 # consider changing over to test.pl at the same time.
  79 # --A.D., Nov 27, 2001
  80 my $limit = 0.20; # 20% is acceptable slosh for testing timers
  81
  82 sub skip {
  83     map { print "ok $_ # skipped\n" } @_;
  84 }
  85
  86 sub ok {
  87     my ($n, $result, @info) = @_;
  88     if ($result) {
  89         print "ok $n\n";
  90     }
  91     else {
  92         print "not ok $n\n";
  93         print "# @info\n" if @info;
  94     }
  95 }
  96
  97 if (!$have_gettimeofday) {
  98     skip 2..6;
  99 }
 100 else {
 101     my @one = gettimeofday();
 102     ok 2, @one == 2, 'gettimeofday returned ', 0+@one, ' args';
 103     ok 3, $one[0] > 850_000_000, "@one too small";
 104
 105     sleep 1;
 106
 107     my @two = gettimeofday();
 108     ok 4, ($two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1])),
 109             "@two is not greater than @one";
 110
 111     my $f = Time::HiRes::time();
 112     ok 5, $f > 850_000_000, "$f too small";
 113     ok 6, $f - $two[0] < 2, "$f - $two[0] >= 2";
 114 }
 115
 116 if (!$have_usleep) {
 117     skip 7..8;
 118 }
 119 else {
 120     my $one = time;
 121     usleep(10_000);
 122     my $two = time;
 123     usleep(10_000);
 124     my $three = time;
 125     ok 7, $one == $two || $two == $three, "slept too long, $one $two $three";
 126
 127     if (!$have_gettimeofday) {
 128         skip 8;
 129     }
 130     else {
 131         my $f = Time::HiRes::time();
 132         usleep(500_000);
 133         my $f2 = Time::HiRes::time();
 134         my $d = $f2 - $f;
 135         ok 8, $d > 0.4 && $d < 0.9, "slept $d secs $f to $f2";
 136     }
 137 }
 138
 139 # Two-arg tv_interval() is always available.
 140 {
 141     my $f = tv_interval [5, 100_000], [10, 500_000];
 142     ok 9, abs($f - 5.4) < 0.001, $f;
 143 }
 144
 145 if (!$have_gettimeofday) {
 146     skip 10;
 147 }
 148 else {
 149     my $r = [gettimeofday()];
 150     my $f = tv_interval $r;
 151     ok 10, $f < 2, $f;
 152 }
 153
 154 if (!$have_usleep || !$have_gettimeofday) {
 155     skip 11;
 156 }
 157 else {
 158     my $r = [gettimeofday()];
 159     Time::HiRes::sleep( 0.5 );
 160     my $f = tv_interval $r;
 161     ok 11, $f > 0.4 && $f < 0.9, "slept $f instead of 0.5 secs.";
 162 }
 163
 164 if (!$have_ualarm || !$have_alarm) {
 165     skip 12..13;
 166 }
 167 else {
 168     my $tick = 0;
 169     local $SIG{ALRM} = sub { $tick++ };
 170
 171     my $one = time; $tick = 0; ualarm(10_000); while ($tick == 0) { sleep }
 172     my $two = time; $tick = 0; ualarm(10_000); while ($tick == 0) { sleep }
 173     my $three = time;
 174     ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
 175
 176     $tick = 0;
 177     ualarm(10_000, 10_000);
 178     while ($tick < 3) { sleep }
 179     ok 13, 1;
 180     ualarm(0);
 181 }
 182
 183 # new test: did we even get close?
 184
 185 if (!$have_time) {
 186     skip 14
 187 } else {
 188  my ($s, $n, $i) = (0);
 189  for $i (1 .. 100) {
 190      $s += Time::HiRes::time() - time();
 191      $n++;
 192  }
 193  # $s should be, at worst, equal to $n
 194  # (time() may be rounding down, up, or closest)
 195  ok 14, abs($s) / $n <= 1.0, "Time::HiRes::time() not close to time()";
 196  print "# s = $s, n = $n, s/n = ", $s/$n, "\n";
 197 }
 198
 199 my $has_ualarm = $Config{d_ualarm};
 200
 201 $has_ualarm ||= $xdefine =~ /-DHAS_UALARM/;
 202
 203 unless (   defined &Time::HiRes::gettimeofday
 204         && defined &Time::HiRes::ualarm
 205         && defined &Time::HiRes::usleep
 206         && $has_ualarm) {
 207     for (15..17) {
 208         print "ok $_ # Skip: no gettimeofday or no ualarm or no usleep\n";
 209     }
 210 } else {
 211     use Time::HiRes qw (time alarm sleep);
 212
 213     my ($f, $r, $i, $not, $ok);
 214
 215     $f = time;
 216     print "# time...$f\n";
 217     print "ok 15\n";
 218
 219     $r = [Time::HiRes::gettimeofday()];
 220     sleep (0.5);
 221     print "# sleep...", Time::HiRes::tv_interval($r), "\nok 16\n";
 222
 223     $r = [Time::HiRes::gettimeofday()];
 224     $i = 5;
 225     $SIG{ALRM} = "tick";
 226     while ($i > 0)
 227     {
 228         alarm(0.3);
 229         select (undef, undef, undef, 3);
 230         my $ival = Time::HiRes::tv_interval ($r);
 231         print "# Select returned! $i $ival\n";
 232         print "# ", abs($ival/3 - 1), "\n";
 233         # Whether select() gets restarted after signals is
 234         # implementation dependent.  If it is restarted, we
 235         # will get about 3.3 seconds: 3 from the select, 0.3
 236         # from the alarm.  If this happens, let's just skip
 237         # this particular test.  --jhi
 238         if (abs($ival/3.3 - 1) < $limit) {
 239             $ok = "Skip: your select() may get restarted by your SIGALRM (or just retry test)";
 240             undef $not;
 241             last;
 242         }
 243         my $exp = 0.3 * (5 - $i);
 244         # This test is more sensitive, so impose a softer limit.
 245         if (abs($ival/$exp - 1) > 3*$limit) {
 246             my $ratio = abs($ival/$exp);
 247             $not = "while: $exp sleep took $ival ratio $ratio";
 248             last;
 249         }
 250         $ok = $i;
 251     }
 252
 253     sub tick
 254     {
 255         $i--;
 256         my $ival = Time::HiRes::tv_interval ($r);
 257         print "# Tick! $i $ival\n";
 258         my $exp = 0.3 * (5 - $i);
 259         # This test is more sensitive, so impose a softer limit.
 260         if (abs($ival/$exp - 1) > 3*$limit) {
 261             my $ratio = abs($ival/$exp);
 262             $not = "tick: $exp sleep took $ival ratio $ratio";
 263             $i = 0;
 264         }
 265     }
 266
 267     alarm(0); # can't cancel usig %SIG
 268
 269     print $not ? "not ok 17 # $not\n" : "ok 17 # $ok\n";
 270 }
 271
 272 unless (   defined &Time::HiRes::setitimer
 273         && defined &Time::HiRes::getitimer
 274         && eval    'Time::HiRes::ITIMER_VIRTUAL'
 275         && $Config{d_select}
 276         && $Config{sig_name} =~ m/\bVTALRM\b/) {
 277     for (18..19) {
 278         print "ok $_ # Skip: no virtual interval timers\n";
 279     }
 280 } else {
 281     use Time::HiRes qw (setitimer getitimer ITIMER_VIRTUAL);
 282
 283     my $i = 3;
 284     my $r = [Time::HiRes::gettimeofday()];
 285
 286     $SIG{VTALRM} = sub {
 287         $i ? $i-- : setitimer(ITIMER_VIRTUAL, 0);
 288         print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n";
 289     };
 290
 291     print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 0.5, 0.4)), "\n";
 292
 293     # Assume interval timer granularity of $limit * 0.5 seconds.  Too bold?
 294     my $virt = getitimer(ITIMER_VIRTUAL);
 295     print "not " unless defined $virt && abs($virt / 0.5) - 1 < $limit;
 296     print "ok 18\n";
 297
 298     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
 299
 300     while (getitimer(ITIMER_VIRTUAL)) {
 301         my $j;
 302         for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer().
 303     }
 304
 305     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
 306
 307     $virt = getitimer(ITIMER_VIRTUAL);
 308     print "not " unless defined $virt && $virt == 0;
 309     print "ok 19\n";
 310
 311     $SIG{VTALRM} = 'DEFAULT';
 312 }
 313
 314 if ($have_gettimeofday) {
 315     my ($t0, $td);
 316
 317     my $sleep = 1.5; # seconds
 318     my $msg;
 319
 320     $t0 = gettimeofday();
 321     $a = abs(sleep($sleep)        / $sleep         - 1.0);
 322     $td = gettimeofday() - $t0;
 323     my $ratio = 1.0 + $a;
 324
 325     $msg = "$td went by while sleeping $sleep, ratio $ratio.\n";
 326
 327     if ($td < $sleep * (1 + $limit)) {
 328         print $a < $limit ? "ok 20 # $msg" : "not ok 20 # $msg";
 329     } else {
 330         print "ok 20 # Skip: $msg";
 331     }
 332
 333     $t0 = gettimeofday();
 334     $a = abs(usleep($sleep * 1E6) / ($sleep * 1E6) - 1.0);
 335     $td = gettimeofday() - $t0;
 336     $ratio = 1.0 + $a;
 337
 338     $msg = "$td went by while sleeping $sleep, ratio $ratio.\n";
 339
 340     if ($td < $sleep * (1 + $limit)) {
 341         print $a < $limit ? "ok 21 # $msg" : "not ok 21 # $msg";
 342     } else {
 343         print "ok 21 # Skip: $msg";
 344     }
 345
 346 } else {
 347     for (20..21) {
 348         print "ok $_ # Skip: no gettimeofday\n";
 349     }
 350 }
 351
 352 eval { sleep(-1) };
 353 print $@ =~ /::sleep\(-1\): negative time not invented yet/ ?
 354     "ok 22\n" : "not ok 22\n";
 355
 356 eval { usleep(-2) };
 357 print $@ =~ /::usleep\(-2\): negative time not invented yet/ ?
 358     "ok 23\n" : "not ok 23\n";
 359
 360 if ($have_ualarm) {
 361     eval { alarm(-3) };
 362     print $@ =~ /::alarm\(-3, 0\): negative time not invented yet/ ?
 363         "ok 24\n" : "not ok 24\n";
 364
 365     eval { ualarm(-4) };
 366     print $@ =~ /::ualarm\(-4, 0\): negative time not invented yet/ ?
 367     "ok 25\n" : "not ok 25\n";
 368 } else {
 369     skip 24;
 370     skip 25;
 371 }
 372
 373 if (defined $pid) {
 374     print "# Terminating the timer process $pid\n";
 375     kill('TERM', $pid); # We are done, the timer can go.
 376 }
 377