1use strict; 2 3use Test::More tests => 5; 4BEGIN { push @INC, '.' } 5use t::Watchdog; 6 7BEGIN { require_ok "Time::HiRes"; } 8 9sub 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 17printf("# have_clock_gettime = %d\n", &Time::HiRes::d_clock_gettime); 18printf("# have_clock_getres = %d\n", &Time::HiRes::d_clock_getres); 19printf("# have_clock_nanosleep = %d\n", &Time::HiRes::d_clock_nanosleep); 20printf("# 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 32my $limit = 0.25; # 25% is acceptable slosh for testing timers 33 34SKIP: { 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 65SKIP: { 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 71SKIP: { 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 80SKIP: { 81 skip "no clock", 1 unless &Time::HiRes::d_clock; 82 skip "no CLOCKS_PER_SEC", 1 unless has_symbol("CLOCKS_PER_SEC"); 83 my @clock = Time::HiRes::clock(); 84 # If we have a relatively low precision clock() and we haven't seen much 85 # CPU usage thus far with clock(), we will want to have a bit longer delay. 86 my $delay = $clock[0] < (5 / &Time::HiRes::CLOCKS_PER_SEC) ? 1e7 : 1e6; 87 printf("# CLOCKS_PER_SEC = %d\n", &Time::HiRes::CLOCKS_PER_SEC); 88 printf("# delay = %d\n", $delay); 89 print("# clock = @clock\n"); 90 for my $i (1..3) { 91 for (my $j = 0; $j < $delay; $j++) { } 92 push @clock, Time::HiRes::clock(); 93 print("# clock = @clock\n"); 94 } 95 ok $clock[0] >= 0 && 96 $clock[1] > $clock[0] && 97 $clock[2] > $clock[1] && 98 $clock[3] > $clock[2]; 99} 100 1011; 102