dist/Time-HiRes/t/clock.t

   1 use strict;
   2
   3 use Test::More tests => 5;
   4 BEGIN { push @INC, '.' }
   5 use t::Watchdog;
   6
   7 BEGIN { require_ok "Time::HiRes"; }
   8
   9 sub has_symbol {
  10     my $symbol = shift;
  11     eval "use Time::HiRes qw($symbol)";
  12     return 0 unless $@ eq '';
  13     eval "my \$a = $symbol";
  14     return $@ eq '';
  15 }
  16
  17 printf("# have_clock_gettime   = %d\n", &Time::HiRes::d_clock_gettime);
  18 printf("# have_clock_getres    = %d\n", &Time::HiRes::d_clock_getres);
  19 printf("# have_clock_nanosleep = %d\n", &Time::HiRes::d_clock_nanosleep);
  20 printf("# have_clock           = %d\n", &Time::HiRes::d_clock);
  21
  22 # Ideally, we'd like to test that the timers are rather precise.
  23 # However, if the system is busy, there are no guarantees on how
  24 # quickly we will return.  This limit used to be 10%, but that
  25 # was occasionally triggered falsely.
  26 # So let's try 25%.
  27 # Another possibility might be to print "ok" if the test completes fine
  28 # with (say) 10% slosh, "skip - system may have been busy?" if the test
  29 # completes fine with (say) 30% slosh, and fail otherwise.  If you do that,
  30 # consider changing over to test.pl at the same time.
  31 # --A.D., Nov 27, 2001
  32 my $limit = 0.25; # 25% is acceptable slosh for testing timers
  33
  34 SKIP: {
  35     skip "no clock_gettime", 1
  36         unless &Time::HiRes::d_clock_gettime && has_symbol("CLOCK_REALTIME");
  37     my $ok = 0;
  38  TRY: {
  39         for my $try (1..3) {
  40             print("# CLOCK_REALTIME: try = $try\n");
  41             my $t0 = Time::HiRes::clock_gettime(&CLOCK_REALTIME);
  42             my $T = 1.5;
  43             Time::HiRes::sleep($T);
  44             my $t1 = Time::HiRes::clock_gettime(&CLOCK_REALTIME);
  45             if ($t0 > 0 && $t1 > $t0) {
  46                 print("# t1 = $t1, t0 = $t0\n");
  47                 my $dt = $t1 - $t0;
  48                 my $rt = abs(1 - $dt / $T);
  49                 print("# dt = $dt, rt = $rt\n");
  50                 if ($rt <= 2 * $limit) {
  51                     $ok = 1;
  52                     last TRY;
  53                 }
  54             } else {
  55                 print("# Error: t0 = $t0, t1 = $t1\n");
  56             }
  57             my $r = rand() + rand();
  58             printf("# Sleeping for %.6f seconds...\n", $r);
  59             Time::HiRes::sleep($r);
  60         }
  61     }
  62     ok $ok;
  63 }
  64
  65 SKIP: {
  66     skip "no clock_getres", 1 unless &Time::HiRes::d_clock_getres;
  67     my $tr = Time::HiRes::clock_getres();
  68     ok $tr > 0 or print("# tr = $tr\n");
  69 }
  70
  71 SKIP: {
  72     skip "no clock_nanosleep", 1
  73         unless &Time::HiRes::d_clock_nanosleep && has_symbol("CLOCK_REALTIME");
  74     my $s = 1.5e9;
  75     my $t = Time::HiRes::clock_nanosleep(&CLOCK_REALTIME, $s);
  76     my $r = abs(1 - $t / $s);
  77     ok $r < 2 * $limit or print("# t = $t, r = $r\n");
  78 }
  79
  80 SKIP: {
  81     skip "no clock", 1 unless &Time::HiRes::d_clock;
  82     my @clock = Time::HiRes::clock();
  83     print("# clock = @clock\n");
  84     for my $i (1..3) {
  85         for (my $j = 0; $j < 1e6; $j++) { }
  86         push @clock, Time::HiRes::clock();
  87         print("# clock = @clock\n");
  88     }
  89     ok $clock[0] >= 0 &&
  90         $clock[1] > $clock[0] &&
  91         $clock[2] > $clock[1] &&
  92         $clock[3] > $clock[2];
  93 }
  94
  95 1;