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.
stat
);
-$VERSION = '1.9715';
+$VERSION = '1.9719';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
There are usually three or four interval timers (signals) available: the
C<$which> can be C<ITIMER_REAL>, C<ITIMER_VIRTUAL>, C<ITIMER_PROF>, or
C<ITIMER_REALPROF>. Note that which ones are available depends: true
-UNIX platforms usually have the first three, but (for example) Win32
-and Cygwin have only C<ITIMER_REAL>, and only Solaris seems to have
-C<ITIMER_REALPROF> (which is used to profile multithreaded programs).
+UNIX platforms usually have the first three, but only Solaris seems to
+have C<ITIMER_REALPROF> (which is used to profile multithreaded programs).
+Win32 unfortunately does not haveinterval timers.
C<ITIMER_REAL> results in C<alarm()>-like behaviour. Time is counted in
I<real time>; that is, wallclock time. C<SIGALRM> is delivered when
CLOCK_REALTIME is zero, it might be one, or something else.
Another potentially useful (but not available everywhere) value is
C<CLOCK_MONOTONIC>, 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 )
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<BSD::Resource>, L<Time::TAI64>.
* 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;
}
#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 */
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;
}
}
#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
{
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;
}
}
#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
}
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");
}
}
-BEGIN { $| = 1; print "1..38\n"; }
+BEGIN { $| = 1; print "1..40\n"; }
END { print "not ok 1\n" unless $loaded }
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";
$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";
}
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);
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);
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";
}
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";
}
projects / p5sagit/p5-mst-13.2.git / commitdiff