From: Rafael Garcia-Suarez Date: Mon, 5 Jan 2009 09:53:40 +0000 (+0100) Subject: Upgrade to Time::HiRes 1.9719 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e5620114d87b855390cf96dfb6fbd3d49cbfdea3;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Time::HiRes 1.9719 --- diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index d710323..ffec191 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,5 +1,29 @@ Revision history for the Perl extension Time::HiRes. +1.9719 [2009-01-04] + - As with QNX, Haiku has the API of interval timers but not + the implementation (bleadperl change #34630), hence skip + the tests, via David Mitchell. + +1.9718 [2008-12-31] + - .xs code cleanup from Albert Dvornik + - in the #39 and #40 do not do us I did, mixing alarm() and + sleep(). Now instead spin until enough time has passed. + +1.9717 [2008-12-30] + - Skip the tests added in 1.9716 (#39, #40) if there's no subsecond + alarm capability, like with the older subsecond alarm tests + +1.9716 [2008-12-26] + - Change documentation to agree with reality: there are + no interval timers in Win32. + - Address [rt.cpan.org #35899] (problem in subsecond sleeps), + add two tests to guard against this problem + - Address [rt.cpan.org #36600] 'Division by zero' failure in test suite + - Address [rt.cpan.org #37340] [PATCH] Address timer process in test + - Address [rt.cpan.org#40311 ] bad implementation of hrt_usleep + with TIME_HIRES_NANOSLEEP + 1.9715 [2008-04-08] - Silly me: Makefile.PL does need to accept arguments other than mine. Some testing frameworks obviously do this. diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index 8b7d2a6..da4d45a 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -23,7 +23,7 @@ require DynaLoader; stat ); -$VERSION = '1.9715'; +$VERSION = '1.9719'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -299,9 +299,9 @@ In list context, both the remaining time and the interval are returned. There are usually three or four interval timers (signals) available: the C<$which> can be C, C, C, or C. Note that which ones are available depends: true -UNIX platforms usually have the first three, but (for example) Win32 -and Cygwin have only C, and only Solaris seems to have -C (which is used to profile multithreaded programs). +UNIX platforms usually have the first three, but only Solaris seems to +have C (which is used to profile multithreaded programs). +Win32 unfortunately does not haveinterval timers. C results in C-like behaviour. Time is counted in I; that is, wallclock time. C is delivered when @@ -344,8 +344,8 @@ January 1, 1970 Greenwich Mean Time (GMT). Do not assume that CLOCK_REALTIME is zero, it might be one, or something else. Another potentially useful (but not available everywhere) value is C, which guarantees a monotonically increasing time -value (unlike time(), which can be adjusted). See your system -documentation for other possibly supported values. +value (unlike time() or gettimeofday(), which can be adjusted). +See your system documentation for other possibly supported values. =item clock_getres ( $which ) @@ -560,6 +560,9 @@ seconds. Time::HiRes will notice this eventually and recalibrate. Note that since Time::HiRes 1.77 the clock_gettime(CLOCK_MONOTONIC) might help in this (in case your system supports CLOCK_MONOTONIC). +Some systems have APIs but not implementations: for example QNX and Haiku +have the interval timer APIs but not the functionality. + =head1 SEE ALSO Perl modules L, L. diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index ec1ff8b..69eee69 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -402,10 +402,10 @@ gettimeofday (struct timeval *tp, void *tpz) * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */ #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) #define HAS_USLEEP -#define usleep hrt_nanosleep /* could conflict with ncurses for static build */ +#define usleep hrt_usleep /* could conflict with ncurses for static build */ void -hrt_nanosleep(unsigned long usec) /* This is used to emulate usleep. */ +hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */ { struct timespec res; res.tv_sec = usec / IV_1E6; @@ -445,21 +445,6 @@ hrt_usleep(unsigned long usec) } #endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */ -#if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) -#define HAS_USLEEP -#define usleep hrt_usleep /* could conflict with ncurses for static build */ - -void -hrt_usleep(unsigned long usec) -{ - struct timespec ts1; - ts1.tv_sec = usec * 1000; /* Ignoring wraparound. */ - ts1.tv_nsec = 0; - nanosleep(&ts1, NULL); -} - -#endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */ - #if !defined(HAS_USLEEP) && defined(HAS_POLL) #define HAS_USLEEP #define usleep hrt_usleep /* could conflict with ncurses for static build */ @@ -925,7 +910,6 @@ ualarm(useconds,uinterval=0) CODE: if (useconds < 0 || uinterval < 0) croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, uinterval); - if (useconds >= IV_1E6 || uinterval >= IV_1E6) #if defined(HAS_SETITIMER) && defined(ITIMER_REAL) { struct itimerval itv; @@ -936,10 +920,10 @@ ualarm(useconds,uinterval=0) } } #else + if (useconds >= IV_1E6 || uinterval >= IV_1E6) croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval equal to or more than %"IVdf, useconds, uinterval, IV_1E6); + RETVAL = ualarm(useconds, uinterval); #endif - else - RETVAL = ualarm(useconds, uinterval); OUTPUT: RETVAL @@ -954,7 +938,6 @@ alarm(seconds,interval=0) { IV useconds = IV_1E6 * seconds; IV uinterval = IV_1E6 * interval; - if (seconds >= IV_1E6 || interval >= IV_1E6) #if defined(HAS_SETITIMER) && defined(ITIMER_REAL) { struct itimerval itv; @@ -965,8 +948,9 @@ alarm(seconds,interval=0) } } #else - RETVAL = (NV)ualarm((IV)(seconds * IV_1E6), - (IV)(interval * IV_1E6)) / NV_1E6; + if (useconds >= IV_1E6 || uinterval >= IV_1E6) + croak("Time::HiRes::alarm(%d, %d): seconds or interval equal to or more than 1.0 ", useconds, uinterval, IV_1E6); + RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6; #endif } diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL index 2ba8ebf..16990ee 100644 --- a/ext/Time/HiRes/Makefile.PL +++ b/ext/Time/HiRes/Makefile.PL @@ -834,7 +834,7 @@ sub doConstants { sub main { if (-f "xdefine" && !(@ARGV && $ARGV[0] eq '--configure')) { print qq[$0: The "xdefine" exists, skipping the configure step.\n]; - print qq[("$0 --configure" to force the configure step)\n]; + print qq[("$^X $0 --configure" to force the configure step)\n]; } else { print "Configuring Time::HiRes...\n"; 1 while unlink("define"); diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index d967348..373c328 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -12,7 +12,7 @@ BEGIN { } } -BEGIN { $| = 1; print "1..38\n"; } +BEGIN { $| = 1; print "1..40\n"; } END { print "not ok 1\n" unless $loaded } @@ -79,11 +79,14 @@ if ($have_fork) { if ($timer_pid == 0) { # We are the kid, set up the timer. my $ppid = getppid(); print "# I am the timer process $$, sleeping for $waitfor seconds...\n"; - sleep($waitfor); - warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n"; - print "# Terminating main process $ppid...\n"; - kill('TERM', $ppid); - print "# This is the timer process $$, over and out.\n"; + sleep($waitfor - 2); # Workaround for perlbug #49073 + sleep(2); # Wait for parent to exit + if (kill(0, $ppid)) { # Check if parent still exists + warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n"; + print "# Terminating main process $ppid...\n"; + kill('KILL', $ppid); + print "# This is the timer process $$, over and out.\n"; + } exit(0); } else { print "# The timer process $timer_pid launched, continuing testing...\n"; @@ -238,10 +241,13 @@ my $has_ualarm = $Config{d_ualarm}; $has_ualarm ||= $xdefine =~ /-DHAS_UALARM/; -unless ( defined &Time::HiRes::gettimeofday - && defined &Time::HiRes::ualarm - && defined &Time::HiRes::usleep - && $has_ualarm) { +my $can_subsecond_alarm = + defined &Time::HiRes::gettimeofday && + defined &Time::HiRes::ualarm && + defined &Time::HiRes::usleep && + $has_ualarm; + +unless ($can_subsecond_alarm) { for (15..17) { print "ok $_ # Skip: no gettimeofday or no ualarm or no usleep\n"; } @@ -301,6 +307,10 @@ unless ( defined &Time::HiRes::gettimeofday last; } my $exp = 0.3 * (5 - $i); + if ($exp == 0) { + $not = "while: divisor became zero"; + last; + } # This test is more sensitive, so impose a softer limit. if (abs($ival/$exp - 1) > 4*$limit) { my $ratio = abs($ival/$exp); @@ -316,6 +326,10 @@ unless ( defined &Time::HiRes::gettimeofday my $ival = Time::HiRes::tv_interval ($r); print "# Tick! $i $ival\n"; my $exp = 0.3 * (5 - $i); + if ($exp == 0) { + $not = "tick: divisor became zero"; + last; + } # This test is more sensitive, so impose a softer limit. if (abs($ival/$exp - 1) > 4*$limit) { my $ratio = abs($ival/$exp); @@ -333,12 +347,13 @@ unless ( defined &Time::HiRes::gettimeofday 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 && has_symbol('ITIMER_VIRTUAL') && $Config{sig_name} =~ m/\bVTALRM\b/ - && $^O !~ /^(nto)$/ # nto: QNX 6 has the API but no implementation - && $^O ne 'haiku') { # same for Haiku + && $^O ne 'nto' # nto: QNX 6 has the API but no implementation + && $^O ne 'haiku' # haiku: has the API but no implementation + ) { for (18..19) { print "ok $_ # Skip: no virtual interval timers\n"; } @@ -730,12 +745,37 @@ if ($^O =~ /^(cygwin|MSWin)/) { skip 38; } +unless ($can_subsecond_alarm) { + skip 39..40; +} else { + { + my $alrm; + $SIG{ALRM} = sub { $alrm++ }; + Time::HiRes::alarm(0.1); + my $t0 = time(); + 1 while time() - $t0 <= 1; + print $alrm ? "ok 39\n" : "not ok 39\n"; + } + { + my $alrm; + $SIG{ALRM} = sub { $alrm++ }; + Time::HiRes::alarm(1.1); + my $t0 = time(); + 1 while time() - $t0 <= 2; + print $alrm ? "ok 40\n" : "not ok 40\n"; + } +} + END { if ($timer_pid) { # Only in the main process. my $left = $TheEnd - time(); printf "# I am the main process $$, terminating the timer process $timer_pid\n# before it terminates me in %d seconds (testing took %d seconds).\n", $left, $waitfor - $left; - my $kill = kill('TERM', $timer_pid); # We are done, the timer can go. - printf "# kill TERM $timer_pid = %d\n", $kill; + if (kill(0, $timer_pid)) { + local $? = 0; + my $kill = kill('KILL', $timer_pid); # We are done, the timer can go. + wait(); + printf "# kill KILL $timer_pid = %d\n", $kill; + } unlink("ktrace.out"); # Used in BSD system call tracing. print "# All done.\n"; }