t/lib/time-hires.t

   1 BEGIN {
   2     chdir 't' if -d 't';
   3     @INC = '../lib';
   4 }
   5
   6 BEGIN { $| = 1; print "1..19\n"; }
   7
   8 END {print "not ok 1\n" unless $loaded;}
   9
  10 use Time::HiRes qw(tv_interval);
  11
  12 $loaded = 1;
  13
  14 print "ok 1\n";
  15
  16 use strict;
  17
  18 my $have_gettimeofday   = defined &Time::HiRes::gettimeofday;
  19 my $have_usleep         = defined &Time::HiRes::usleep;
  20 my $have_ualarm         = defined &Time::HiRes::ualarm;
  21
  22 import Time::HiRes 'gettimeofday'       if $have_gettimeofday;
  23 import Time::HiRes 'usleep'             if $have_usleep;
  24 import Time::HiRes 'ualarm'             if $have_ualarm;
  25
  26 use Config;
  27
  28 sub skip {
  29     map { print "ok $_ (skipped)\n" } @_;
  30 }
  31
  32 sub ok {
  33     my ($n, $result, @info) = @_;
  34     if ($result) {
  35         print "ok $n\n";
  36     }
  37     else {
  38         print "not ok $n\n";
  39         print "# @info\n" if @info;
  40     }
  41 }
  42
  43 if (!$have_gettimeofday) {
  44     skip 2..6;
  45 }
  46 else {
  47     my @one = gettimeofday();
  48     ok 2, @one == 2, 'gettimeofday returned ', 0+@one, ' args';
  49     ok 3, $one[0] > 850_000_000, "@one too small";
  50
  51     sleep 1;
  52
  53     my @two = gettimeofday();
  54     ok 4, ($two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1])),
  55             "@two is not greater than @one";
  56
  57     my $f = Time::HiRes::time;
  58     ok 5, $f > 850_000_000, "$f too small";
  59     ok 6, $f - $two[0] < 2, "$f - @two >= 2";
  60 }
  61
  62 if (!$have_usleep) {
  63     skip 7..8;
  64 }
  65 else {
  66     my $one = time;
  67     usleep(10_000);
  68     my $two = time;
  69     usleep(10_000);
  70     my $three = time;
  71     ok 7, $one == $two || $two == $three, "slept too long, $one $two $three";
  72
  73     if (!$have_gettimeofday) {
  74         skip 8;
  75     }
  76     else {
  77         my $f = Time::HiRes::time;
  78         usleep(500_000);
  79         my $f2 = Time::HiRes::time;
  80         my $d = $f2 - $f;
  81         ok 8, $d > 0.4 && $d < 0.8, "slept $d secs $f to $f2";
  82     }
  83 }
  84
  85 # Two-arg tv_interval() is always available.
  86 {
  87     my $f = tv_interval [5, 100_000], [10, 500_000];
  88     ok 9, $f == 5.4, $f;
  89 }
  90
  91 if (!$have_gettimeofday) {
  92     skip 10;
  93 }
  94 else {
  95     my $r = [gettimeofday()];
  96     my $f = tv_interval $r;
  97     ok 10, $f < 2, $f;
  98 }
  99
 100 if (!$have_usleep) {
 101     skip 11;
 102 }
 103 else {
 104     my $r = [gettimeofday()];
 105     #jTime::HiRes::sleep 0.5;
 106     Time::HiRes::sleep( 0.5 );
 107     my $f = tv_interval $r;
 108     ok 11, $f > 0.4 && $f < 0.8, "slept $f secs";
 109 }
 110
 111 if (!$have_ualarm) {
 112     skip 12..13;
 113 }
 114 else {
 115     my $tick = 0;
 116     local $SIG{ALRM} = sub { $tick++ };
 117
 118     my $one = time; $tick = 0; ualarm(10_000); sleep until $tick;
 119     my $two = time; $tick = 0; ualarm(10_000); sleep until $tick;
 120     my $three = time;
 121     ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
 122
 123     $tick = 0;
 124     ualarm(10_000, 10_000);
 125     sleep until $tick >= 3;
 126     ok 13, 1;
 127     ualarm(0);
 128 }
 129
 130 # new test: did we even get close?
 131
 132 {
 133  my $t = time();
 134  my $tf = Time::HiRes::time();
 135  ok 14, ($tf >= $t) && (($tf - $t) <= 1),
 136   "time $t differs from Time::HiRes::time $tf";
 137 }
 138
 139 unless (defined &Time::HiRes::gettimeofday
 140         && defined &Time::HiRes::ualarm
 141         && defined &Time::HiRes::usleep) {
 142     for (15..17) {
 143         print "ok $_ # skipped\n";
 144     }
 145 } else {
 146     use Time::HiRes qw (time alarm sleep);
 147
 148     my ($f, $r, $i);
 149
 150     print "# time...";
 151     $f = time;
 152     print "$f\nok 15\n";
 153
 154     print "# sleep...";
 155     $r = [Time::HiRes::gettimeofday];
 156     sleep (0.5);
 157     print Time::HiRes::tv_interval($r), "\nok 16\n";
 158
 159     $r = [Time::HiRes::gettimeofday];
 160     $i = 5;
 161     $SIG{ALRM} = "tick";
 162     while ($i)
 163     {
 164         alarm(2.5);
 165         select (undef, undef, undef, 10);
 166         print "# Select returned! $i ", Time::HiRes::tv_interval ($r), "\n";
 167     }
 168
 169     sub tick
 170     {
 171         $i--;
 172         print "# Tick! $i ", Time::HiRes::tv_interval ($r), "\n";
 173     }
 174     $SIG{ALRM} = 'DEFAULT';
 175
 176     print "ok 17\n";
 177 }
 178
 179 unless (defined &Time::HiRes::setitimer
 180         && defined &Time::HiRes::getitimer
 181         && exists &Time::HiRes::ITIMER_VIRTUAL
 182         && $Config{d_select}) {
 183     for (18..19) {
 184         print "ok $_ # skipped\n";
 185     }
 186 } else {
 187     use Time::HiRes qw (setitimer getitimer ITIMER_VIRTUAL);
 188
 189     my $i = 3;
 190     my $r = [Time::HiRes::gettimeofday];
 191
 192     $SIG{VTALRM} = sub {
 193         $i ? $i-- : setitimer(ITIMER_VIRTUAL, 0);
 194         print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n";
 195     };
 196
 197     print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 3, 0.5)), "\n";
 198
 199     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
 200
 201     while ($i) {
 202         my $j; $j++ for 1..1000;
 203     }
 204
 205     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
 206
 207     $SIG{VTALRM} = 'DEFAULT';
 208 }
 209