Revision history for Perl extension Time::HiRes.
+1.66
+ - add nanosleep()
+ - fix the 'hierachy' typo in Makefile.PL [rt.cpan.org #8492]
+ - should now build in Solaris [rt.cpan.org #7165] (since 1.64)
+ - should now build in Cygwin [rt.cpan.org #7535] (since 1.64)
+ - close also [rt.cpan.org #5933] "Time::HiRes::time does not pick up time adjustments like ntp" since ever reproducing it in the same environment
+ has become rather unlikely
+
1.65
- one should not mix u?alarm and sleep (the tests modified
by 1.65, #12 and #13, hung in Solaris), now we just busy
@EXPORT = qw( );
@EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
- getitimer setitimer
+ getitimer setitimer nanosleep
ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF
d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
d_nanosleep);
-$VERSION = '1.65';
+$VERSION = '1.66';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
=head1 SYNOPSIS
- use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
+ use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep );
usleep ($microseconds);
+ nanosleep ($nanoseconds);
ualarm ($microseconds);
ualarm ($microseconds, $interval_microseconds);
=head1 DESCRIPTION
The C<Time::HiRes> module implements a Perl interface to the
-C<usleep>, C<ualarm>, C<gettimeofday>, and C<setitimer>/C<getitimer>
-system calls, in other words, high resolution time and timers. See the
-L</EXAMPLES> section below and the test scripts for usage; see your
-system documentation for the description of the underlying
-C<nanosleep> or C<usleep>, C<ualarm>, C<gettimeofday>, and
-C<setitimer>/C<getitimer> calls.
+C<usleep>, C<nanosleep>, C<ualarm>, C<gettimeofday>, and
+C<setitimer>/C<getitimer> system calls, in other words, high
+resolution time and timers. See the L</EXAMPLES> section below and the
+test scripts for usage; see your system documentation for the
+description of the underlying C<nanosleep> or C<usleep>, C<ualarm>,
+C<gettimeofday>, and C<setitimer>/C<getitimer> calls.
If your system lacks C<gettimeofday()> or an emulation of it you don't
get C<gettimeofday()> or the one-argument form of C<tv_interval()>.
If your system lacks all of C<nanosleep()>, C<usleep()>, and
-C<select()>, you don't get C<Time::HiRes::usleep()> or
-C<Time::HiRes::sleep()>. If your system lacks both C<ualarm()> and
-C<setitimer()> you don't get C<Time::HiRes::ualarm()> or
-C<Time::HiRes::alarm()>.
+C<select()>, you don't get C<Time::HiRes::usleep()>,
+C<Time::HiRes::nanosleep()>, or C<Time::HiRes::sleep()>. If your
+system lacks both C<ualarm()> and C<setitimer()> you don't get
+C<Time::HiRes::ualarm()> or C<Time::HiRes::alarm()>.
If you try to import an unimplemented function in the C<use> statement
it will fail at compile time.
and you should first check for the truth value of
C<&Time::HiRes::d_nanosleep> to see whether you have nanosleep, and
then carefully read your C<nanosleep()> C API documentation for any
-peculiarities. (There is no separate interface to call
-C<nanosleep()>; just use C<Time::HiRes::sleep()> or
-C<Time::HiRes::usleep()> with small enough values.)
+peculiarities.
Unless using C<nanosleep> for mixing sleeping with signals, give
some thought to whether Perl is the tool you should be using for
=item usleep ( $useconds )
-Sleeps for the number of microseconds specified. Returns the number
-of microseconds actually slept. Can sleep for more than one second,
-unlike the C<usleep> system call. See also C<Time::HiRes::sleep()> below.
+Sleeps for the number of microseconds (millionths of a second)
+specified. Returns the number of microseconds actually slept. Can
+sleep for more than one second, unlike the C<usleep> system call. See
+also C<Time::HiRes::usleep()> and C<Time::HiRes::sleep()>.
+
+Do not expect usleep() to be exact down to one microsecond.
+
+=item nanosleep ( $nanoseconds )
+
+Sleeps for the number of nanoseconds (1e9ths of a second) specified.
+Returns the number of nanoseconds actually slept (accurate only to
+microseconds, the nearest thousand of them). Can sleep for more than
+one second. See also C<Time::HiRes::sleep()> and
+C<Time::HiRes::usleep()>.
+
+Do not expect nanosleep() to be exact down to one nanosecond.
+Getting even accuracy of one thousand nanoseconds is good.
=item ualarm ( $useconds [, $interval_useconds ] )
* 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_unanosleep /* could conflict with ncurses for static build */
void
-hrt_nanosleep(unsigned long usec)
+hrt_unanosleep(unsigned long usec) /* This is used to emulate usleep. */
{
struct timespec res;
res.tv_sec = usec/1000/1000;
res.tv_nsec = ( usec - res.tv_sec*1000*1000 ) * 1000;
nanosleep(&res, NULL);
}
-#endif
+#endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
#if !defined(HAS_USLEEP) && defined(HAS_SELECT)
#ifndef SELECT_IS_BROKEN
(Select_fd_set_t)NULL, &tv);
}
#endif
-#endif
+#endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */
#if !defined(HAS_USLEEP) && defined(WIN32)
#define HAS_USLEEP
msec = usec / 1000;
Sleep (msec);
}
-#endif
+#endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
#if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
itv.it_interval.tv_usec = interval % 1000000;
return setitimer(ITIMER_REAL, &itv, 0);
}
-#endif
+#endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */
#if !defined(HAS_UALARM) && defined(VMS)
#define HAS_UALARM
}
}
-#endif /* !HAS_UALARM && VMS */
+#endif /* #if !defined(HAS_UALARM) && defined(VMS) */
#ifdef HAS_GETTIMEOFDAY
return status == 0 ? Tp.tv_sec + (Tp.tv_usec / 1000000.) : -1.0;
}
-#endif
+#endif /* #ifdef HAS_GETTIMEOFDAY */
MODULE = Time::HiRes PACKAGE = Time::HiRes
OUTPUT:
RETVAL
+#if defined(TIME_HIRES_NANOSLEEP)
+
+NV
+nanosleep(nseconds)
+ NV nseconds
+ PREINIT:
+ struct timeval Ta, Tb;
+ CODE:
+ gettimeofday(&Ta, NULL);
+ if (items > 0) {
+ struct timespec tsa;
+ if (nseconds > 1E9) {
+ IV seconds = (IV) (nseconds / 1E9);
+ if (seconds) {
+ sleep(seconds);
+ nseconds -= 1E9 * seconds;
+ }
+ } else if (nseconds < 0.0)
+ croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nseconds);
+ tsa.tv_sec = (IV) (nseconds / 1E9);
+ tsa.tv_nsec = (IV) nseconds - tsa.tv_sec * 1E9;
+ nanosleep(&tsa, NULL);
+ } else
+ PerlProc_pause();
+ gettimeofday(&Tb, NULL);
+ RETVAL = 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec));
+
+ OUTPUT:
+ RETVAL
+
+#endif /* #if defined(TIME_HIRES_NANOSLEEP) */
+
NV
sleep(...)
PREINIT:
* circumstances (if the double is cast to UV more
* than once?) evaluate to -0.5, instead of 0.5. */
useconds = -(IV)useconds;
-#endif
+#endif /* #if defined(__sparc64__) && defined(__GNUC__) */
if ((IV)useconds < 0)
croak("Time::HiRes::sleep(%"NVgf"): internal error: useconds < 0 (unsigned %"UVuf" signed %"IVdf")", seconds, useconds, (IV)useconds);
}
OUTPUT:
RETVAL
-#endif
+#endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
#ifdef HAS_UALARM
OUTPUT:
RETVAL
-#endif
+#endif /* #ifdef HAS_UALARM */
#ifdef HAS_GETTIMEOFDAY
# ifdef MACOS_TRADITIONAL /* fix epoch TZ and use unsigned time_t */
RETVAL
# endif /* MACOS_TRADITIONAL */
-#endif
+#endif /* #ifdef HAS_GETTIMEOFDAY */
#if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
}
}
-#endif
+#endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
+
}
}
-BEGIN { $| = 1; print "1..25\n"; }
+BEGIN { $| = 1; print "1..28\n"; }
END {print "not ok 1\n" unless $loaded;}
my $have_gettimeofday = defined &Time::HiRes::gettimeofday;
my $have_usleep = defined &Time::HiRes::usleep;
+my $have_nanosleep = defined &Time::HiRes::nanosleep;
my $have_ualarm = defined &Time::HiRes::ualarm;
my $have_time = defined &Time::HiRes::time;
import Time::HiRes 'gettimeofday' if $have_gettimeofday;
import Time::HiRes 'usleep' if $have_usleep;
+import Time::HiRes 'nanosleep' if $have_nanosleep;
import Time::HiRes 'ualarm' if $have_ualarm;
use Config;
my $pid;
if ($have_fork) {
- print "# Testing process $$\n";
- print "# Starting the timer process\n";
+ print "# I am process $$, starting the timer process\n";
if (defined ($pid = fork())) {
if ($pid == 0) { # We are the kid, set up the timer.
- print "# Timer process $$\n";
+ print "# I am timer process $$\n";
sleep($waitfor);
warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded\n";
print "# Terminating the testing process\n";
}
}
+if (!$have_nanosleep) {
+ skip 22..23;
+}
+else {
+ my $one = CORE::time;
+ nanosleep(10_000_000);
+ my $two = CORE::time;
+ nanosleep(10_000_000);
+ my $three = CORE::time;
+ ok 22, $one == $two || $two == $three, "slept too long, $one $two $three";
+
+ if (!$have_gettimeofday) {
+ skip 23;
+ }
+ else {
+ my $f = Time::HiRes::time();
+ nanosleep(500_000_000);
+ my $f2 = Time::HiRes::time();
+ my $d = $f2 - $f;
+ ok 23, $d > 0.4 && $d < 0.9, "slept $d secs $f to $f2";
+ }
+}
+
eval { sleep(-1) };
print $@ =~ /::sleep\(-1\): negative time not invented yet/ ?
- "ok 22\n" : "not ok 22\n";
+ "ok 24\n" : "not ok 24\n";
eval { usleep(-2) };
print $@ =~ /::usleep\(-2\): negative time not invented yet/ ?
- "ok 23\n" : "not ok 23\n";
+ "ok 25\n" : "not ok 25\n";
if ($have_ualarm) {
eval { alarm(-3) };
print $@ =~ /::alarm\(-3, 0\): negative time not invented yet/ ?
- "ok 24\n" : "not ok 24\n";
+ "ok 26\n" : "not ok 26\n";
eval { ualarm(-4) };
print $@ =~ /::ualarm\(-4, 0\): negative time not invented yet/ ?
- "ok 25\n" : "not ok 25\n";
+ "ok 27\n" : "not ok 27\n";
+} else {
+ skip 26;
+ skip 27;
+}
+
+if ($have_nanosleep) {
+ eval { nanosleep(-5) };
+ print $@ =~ /::nanosleep\(-5\): negative time not invented yet/ ?
+ "ok 28\n" : "not ok 28\n";
} else {
- skip 24;
- skip 25;
+ skip 28;
}
if (defined $pid) {
- print "# Terminating the timer process $pid\n";
+ print "# I am process $$, terminating the timer process $pid\n";
kill('TERM', $pid); # We are done, the timer can go.
unlink("ktrace.out");
}
projects / p5sagit/p5-mst-13.2.git / commitdiff