Rework Time::HiRes not to need HAS_NANOSLEEP from Configure.
[p5sagit/p5-mst-13.2.git] / ext / Time / HiRes / HiRes.t
index 489829e..9f6239a 100644 (file)
@@ -1,6 +1,10 @@
+#!./perl -w
+
 BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($ENV{PERL_CORE}) {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+    }
 }
 
 BEGIN { $| = 1; print "1..25\n"; }
@@ -26,6 +30,13 @@ import Time::HiRes 'ualarm'          if $have_ualarm;
 
 use Config;
 
+my $xdefine = ''; 
+
+if (open(XDEFINE, "xdefine")) {
+    chomp($xdefine = <XDEFINE>);
+    close(XDEFINE);
+}
+
 # Ideally, we'd like to test that the timers are rather precise.
 # However, if the system is busy, there are no guarantees on how
 # quickly we will return.  This limit used to be 10%, but that
@@ -39,7 +50,7 @@ use Config;
 my $limit = 0.20; # 20% is acceptable slosh for testing timers
 
 sub skip {
-    map { print "ok $_ (skipped)\n" } @_;
+    map { print "ok $_ # skipped\n" } @_;
 }
 
 sub ok {
@@ -115,7 +126,6 @@ if (!$have_usleep || !$have_gettimeofday) {
 }
 else {
     my $r = [gettimeofday()];
-    #jTime::HiRes::sleep 0.5;
     Time::HiRes::sleep( 0.5 );
     my $f = tv_interval $r;
     ok 11, $f > 0.4 && $f < 0.9, "slept $f instead of 0.5 secs.";
@@ -128,14 +138,14 @@ else {
     my $tick = 0;
     local $SIG{ALRM} = sub { $tick++ };
 
-    my $one = time; $tick = 0; ualarm(10_000); sleep until $tick;
-    my $two = time; $tick = 0; ualarm(10_000); sleep until $tick;
+    my $one = time; $tick = 0; ualarm(10_000); while ($tick == 0) { sleep }
+    my $two = time; $tick = 0; ualarm(10_000); while ($tick == 0) { sleep }
     my $three = time;
     ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
 
     $tick = 0;
     ualarm(10_000, 10_000);
-    sleep until $tick >= 3;
+    while ($tick < 3) { sleep }
     ok 13, 1;
     ualarm(0);
 }
@@ -156,17 +166,21 @@ if (!$have_time) {
  print "# s = $s, n = $n, s/n = ", $s/$n, "\n";
 }
 
-unless (defined &Time::HiRes::gettimeofday
+my $has_ualarm = $Config{d_ualarm};
+
+$has_ualarm ||= $xdefine =~ /-DHAS_UALARM/;
+
+unless (   defined &Time::HiRes::gettimeofday
        && defined &Time::HiRes::ualarm
        && defined &Time::HiRes::usleep
-       && $Config{d_ualarm}) {
+       && $has_ualarm) {
     for (15..17) {
-       print "ok $_ # skipped\n";
+       print "ok $_ # Skip: no gettimeofday or no ualarm or no usleep\n";
     }
 } else {
     use Time::HiRes qw (time alarm sleep);
 
-    my ($f, $r, $i, $not);
+    my ($f, $r, $i, $not, $ok);
 
     $f = time; 
     print "# time...$f\n";
@@ -185,13 +199,25 @@ unless (defined &Time::HiRes::gettimeofday
        select (undef, undef, undef, 3);
        my $ival = Time::HiRes::tv_interval ($r);
        print "# Select returned! $i $ival\n";
+       print "# ", abs($ival/3 - 1), "\n";
+       # Whether select() gets restarted after signals is
+       # implementation dependent.  If it is restarted, we
+       # will get about 3.3 seconds: 3 from the select, 0.3
+       # from the alarm.  If this happens, let's just skip
+       # this particular test.  --jhi
+       if (abs($ival/3.3 - 1) < $limit) {
+           $ok = "Skip: your select() may get restarted by your SIGALRM (or just retry test)";
+           undef $not;
+           last;
+       }
        my $exp = 0.3 * (5 - $i);
        # This test is more sensitive, so impose a softer limit.
-       if (abs($ival/$exp) - 1 > 3*$limit) {
+       if (abs($ival/$exp - 1) > 3*$limit) {
            my $ratio = abs($ival/$exp);
            $not = "while: $exp sleep took $ival ratio $ratio";
            last;
        }
+       $ok = $i;
     }
 
     sub tick
@@ -201,7 +227,7 @@ unless (defined &Time::HiRes::gettimeofday
        print "# Tick! $i $ival\n";
        my $exp = 0.3 * (5 - $i);
        # This test is more sensitive, so impose a softer limit.
-       if (abs($ival/$exp) - 1 > 3*$limit) {
+       if (abs($ival/$exp - 1) > 3*$limit) {
            my $ratio = abs($ival/$exp);
            $not = "tick: $exp sleep took $ival ratio $ratio";
            $i = 0;
@@ -210,12 +236,12 @@ unless (defined &Time::HiRes::gettimeofday
 
     alarm(0); # can't cancel usig %SIG
 
-    print $not ? "not ok 17 # $not\n" : "ok 17\n";
+    print $not ? "not ok 17 # $not\n" : "ok 17 # $ok\n";
 }
 
-unless (defined &Time::HiRes::setitimer
+unless (   defined &Time::HiRes::setitimer
        && defined &Time::HiRes::getitimer
-       && exists &Time::HiRes::ITIMER_VIRTUAL
+       && eval    'Time::HiRes::ITIMER_VIRTUAL'
        && $Config{d_select}
        && $Config{sig_name} =~ m/\bVTALRM\b/) {
     for (18..19) {
@@ -241,7 +267,8 @@ unless (defined &Time::HiRes::setitimer
     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
 
     while (getitimer(ITIMER_VIRTUAL)) {
-       my $j; $j++ for 1..1000; # Can't be unbreakable, must test getitimer().
+       my $j;
+       for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer().
     }
 
     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";