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