[Orca-checkins] r415 - in trunk/orca: . packages/Time-HiRes-1.65 packages/Time-HiRes-1.66 packages/Time-HiRes-1.66/t
Blair Zajac
blair at orcaware.com
Tue Feb 15 22:24:34 PST 2005
Author: blair
Date: Tue Feb 15 22:22:46 2005
New Revision: 415
Added:
trunk/orca/packages/Time-HiRes-1.66/
- copied from r414, trunk/orca/packages/Time-HiRes-1.65/
Removed:
trunk/orca/packages/Time-HiRes-1.65/
Modified:
trunk/orca/INSTALL
trunk/orca/configure.in
trunk/orca/packages/Time-HiRes-1.66/Changes
trunk/orca/packages/Time-HiRes-1.66/HiRes.pm
trunk/orca/packages/Time-HiRes-1.66/HiRes.xs
trunk/orca/packages/Time-HiRes-1.66/META.yml
trunk/orca/packages/Time-HiRes-1.66/Makefile.PL
trunk/orca/packages/Time-HiRes-1.66/t/HiRes.t
Log:
Upgrade Time::HiRes from 1.65 to 1.66.
* INSTALL (Determine which Perl modules need compiling and installing):
Update all references to Time::HiRes's version number from 1.65 to
1.66.
* configure.in:
Bump Time::HiRes's version number to 1.66.
* packages/Time-HiRes-1.66:
Renamed from packages/Time-HiRes-1.65. Directory contents updated
from Time-HiRes-1.66.tar.gz.
Modified: trunk/orca/INSTALL
==============================================================================
--- trunk/orca/INSTALL (original)
+++ trunk/orca/INSTALL Tue Feb 15 22:22:46 2005
@@ -177,7 +177,7 @@
Math::IntervalSearch >= 1.05 >= 1.05 1.05
RRDs >= 1.000491 >= 1.0.49 1.0.49
Storable >= 2.13 >= 2.13 2.13
- Time::HiRes Not required by Orca 1.65
+ Time::HiRes Not required by Orca 1.66
version >= 0.42 >= 0.42 0.42
All seven of these modules are included with the Orca distribution
@@ -279,10 +279,10 @@
Time::HiRes
- http://www.perl.com/CPAN/authors/id/J/JH/JHI/Time-HiRes-1.65.tar.gz
+ http://www.perl.com/CPAN/authors/id/J/JH/JHI/Time-HiRes-1.66.tar.gz
- % gunzip -c Time-HiRes-1.65.tar.gz | tar xvf -
- % cd Time-HiRes-1.65
+ % gunzip -c Time-HiRes-1.66.tar.gz | tar xvf -
+ % cd Time-HiRes-1.66
% perl Makefile.PL
% make
% make test
Modified: trunk/orca/configure.in
==============================================================================
--- trunk/orca/configure.in (original)
+++ trunk/orca/configure.in Tue Feb 15 22:22:46 2005
@@ -41,8 +41,8 @@
RRDTOOL_VER=1.000491
STORABLE_DIR=Storable-2.13
STORABLE_VER=2.13
-TIME_HIRES_DIR=Time-HiRes-1.65
-TIME_HIRES_VER=1.65
+TIME_HIRES_DIR=Time-HiRes-1.66
+TIME_HIRES_VER=1.66
VERSION_DIR=version-0.42
VERSION_VER=0.42
Modified: trunk/orca/packages/Time-HiRes-1.66/Changes
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/Changes (original)
+++ trunk/orca/packages/Time-HiRes-1.66/Changes Tue Feb 15 22:22:46 2005
@@ -1,5 +1,13 @@
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
Modified: trunk/orca/packages/Time-HiRes-1.66/HiRes.pm
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/HiRes.pm (original)
+++ trunk/orca/packages/Time-HiRes-1.66/HiRes.pm Tue Feb 15 22:22:46 2005
@@ -10,12 +10,12 @@
@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;
@@ -54,9 +54,10 @@
=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);
@@ -84,20 +85,20 @@
=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.
@@ -108,9 +109,7 @@
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
@@ -129,9 +128,23 @@
=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 ] )
Modified: trunk/orca/packages/Time-HiRes-1.66/HiRes.xs
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/HiRes.xs (original)
+++ trunk/orca/packages/Time-HiRes-1.66/HiRes.xs Tue Feb 15 22:22:46 2005
@@ -351,18 +351,18 @@
* 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
@@ -379,7 +379,7 @@
(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
@@ -392,7 +392,7 @@
msec = usec / 1000;
Sleep (msec);
}
-#endif
+#endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
#if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
@@ -409,7 +409,7 @@
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
@@ -606,7 +606,7 @@
}
}
-#endif /* !HAS_UALARM && VMS */
+#endif /* #if !defined(HAS_UALARM) && defined(VMS) */
#ifdef HAS_GETTIMEOFDAY
@@ -633,7 +633,7 @@
return status == 0 ? Tp.tv_sec + (Tp.tv_usec / 1000000.) : -1.0;
}
-#endif
+#endif /* #ifdef HAS_GETTIMEOFDAY */
MODULE = Time::HiRes PACKAGE = Time::HiRes
@@ -700,6 +700,38 @@
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:
@@ -719,7 +751,7 @@
* 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);
}
@@ -737,7 +769,7 @@
OUTPUT:
RETVAL
-#endif
+#endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
#ifdef HAS_UALARM
@@ -766,7 +798,7 @@
OUTPUT:
RETVAL
-#endif
+#endif /* #ifdef HAS_UALARM */
#ifdef HAS_GETTIMEOFDAY
# ifdef MACOS_TRADITIONAL /* fix epoch TZ and use unsigned time_t */
@@ -832,7 +864,7 @@
RETVAL
# endif /* MACOS_TRADITIONAL */
-#endif
+#endif /* #ifdef HAS_GETTIMEOFDAY */
#if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
@@ -879,5 +911,6 @@
}
}
-#endif
+#endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
+
Modified: trunk/orca/packages/Time-HiRes-1.66/META.yml
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/META.yml (original)
+++ trunk/orca/packages/Time-HiRes-1.66/META.yml Tue Feb 15 22:22:46 2005
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Time-HiRes
-version: 1.65
+version: 1.66
version_from: HiRes.pm
installdirs: perl
requires:
Modified: trunk/orca/packages/Time-HiRes-1.66/Makefile.PL
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/Makefile.PL (original)
+++ trunk/orca/packages/Time-HiRes-1.66/Makefile.PL Tue Feb 15 22:22:46 2005
@@ -98,7 +98,7 @@
if ($^O eq 'VMS') {
if ($ENV{PERL_CORE}) {
- # Fragile if the extensions change hierachy within
+ # Fragile if the extensions change hierarchy within
# the Perl core but this should do for now.
$cccmd = "$Config{'cc'} /include=([---]) $tmp.c";
} else {
Modified: trunk/orca/packages/Time-HiRes-1.66/t/HiRes.t
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.65/t/HiRes.t (original)
+++ trunk/orca/packages/Time-HiRes-1.66/t/HiRes.t Tue Feb 15 22:22:46 2005
@@ -12,7 +12,7 @@
}
}
-BEGIN { $| = 1; print "1..25\n"; }
+BEGIN { $| = 1; print "1..28\n"; }
END {print "not ok 1\n" unless $loaded;}
@@ -26,11 +26,13 @@
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;
@@ -41,11 +43,10 @@
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";
@@ -349,29 +350,60 @@
}
}
+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");
}
More information about the Orca-checkins
mailing list