ext/Time/HiRes/HiRes.t

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