[Orca-checkins] r516 - in orca/trunk: . packages/Time-HiRes-1.73 packages/Time-HiRes-1.83 packages/Time-HiRes-1.83/fallback packages/Time-HiRes-1.83/t
blair at orcaware.com
blair at orcaware.com
Thu Dec 1 21:14:05 PST 2005
Author: blair at orcaware.com
Date: Thu Dec 1 21:13:32 2005
New Revision: 516
Added:
orca/trunk/packages/Time-HiRes-1.83/
- copied from r515, /orca/trunk/packages/Time-HiRes-1.73/
Removed:
orca/trunk/packages/Time-HiRes-1.73/
Modified:
orca/trunk/configure.in
orca/trunk/packages/Time-HiRes-1.83/Changes
orca/trunk/packages/Time-HiRes-1.83/HiRes.pm
orca/trunk/packages/Time-HiRes-1.83/HiRes.xs
orca/trunk/packages/Time-HiRes-1.83/META.yml
orca/trunk/packages/Time-HiRes-1.83/Makefile.PL
orca/trunk/packages/Time-HiRes-1.83/fallback/const-c.inc
orca/trunk/packages/Time-HiRes-1.83/fallback/const-xs.inc
orca/trunk/packages/Time-HiRes-1.83/t/HiRes.t
Log:
Upgrade Time::HiRes from 1.73 to 1.83.
* configure.in:
Bump Time::HiRes's version number to 1.83.
* packages/Time-HiRes-1.83:
Renamed from packages/Time-HiRes-1.73. Directory contents updated
from Time-HiRes-1.83.tar.gz.
Modified: orca/trunk/configure.in
==============================================================================
--- orca/trunk/configure.in (original)
+++ orca/trunk/configure.in Thu Dec 1 21:13:32 2005
@@ -39,8 +39,8 @@
RRDTOOL_VER=1.000503
STORABLE_DIR=Storable-2.15
STORABLE_VER=2.15
-TIME_HIRES_DIR=Time-HiRes-1.73
-TIME_HIRES_VER=1.73
+TIME_HIRES_DIR=Time-HiRes-1.83
+TIME_HIRES_VER=1.83
AC_SUBST(DATA_DUMPER_DIR)
AC_SUBST(DATE_PARSE_DIR)
Modified: orca/trunk/packages/Time-HiRes-1.83/Changes
==============================================================================
--- /orca/trunk/packages/Time-HiRes-1.73/Changes (original)
+++ orca/trunk/packages/Time-HiRes-1.83/Changes Thu Dec 1 21:13:32 2005
@@ -1,23 +1,119 @@
Revision history for Perl extension Time::HiRes.
-1.73 - Time::HiRes::nanosleep support for Solaris [PATCH]
+1.83 [2005-11-19]
+ - has_symbol() was wrong since e.g. ITIMER_VIRTUAL is exported
+ via @EXPORT_OK even when it is not available. This is heinous.
+ @EXPORT_OK should be determined at Makefile.PL time.
+ - be more lenient is testing clock_gettime(): allow more slop,
+ and retry up to three times, sleeping a random nap between
+ the retries
+ - human months are one-based (noticed by Anton Berezin)
+
+1.82 [2005-10-06]
+ - CLOCK_REALTIME is an enum value (of the clockid_t enum)
+ in HP-UX (and might be so elsewhere, too), debugged by
+ H. Merijn Brand
+ - include const-c.inc as late as possible (from Randy Kobes,
+ [rt.cpan.org #15552] to avoid undefined usleep() on Win32
+
+1.81 [2005-11-05]
+ - try to be more robust and consistent in the detection of
+ CLOCK_REALTIME and ITIMER_VIRTUAL in HiRes.t: the proper
+ way is
+
+ sub has_symbol {
+ my $symbol = shift;
+ eval 'import Time::HiRes qw($symbol)';
+ return 0 unless $@ eq '';
+ return exists ${"Time::HiRes::$symbol"};
+ }
+
+ and then use
+
+ &FOO_BAR
+
+ in the test. All these moves are needed because
+
+ 1) one cannot directly do eval 'Time::HiRes::FOO_BAR'
+ because FOO_BAR might have a true value of zero
+ (or in the general case an empty string or even undef)
+
+ 2) In case FOO_BAR is not available in this platform,
+ &FOO_BAR avoids the bareword warning
+
+ - wait more (1.5 seconds instead of 0.1) for the CLOCK_REALTIME test
+ but expect the 'customary' slop of 0.20 instead of 0.25
+ - fixed inside a comment HAS_POLL -> TIME_HIRES_NANOSLEEP
+ - at the end of HiRest.t tell how close we were to termination
+
+1.80 [2005-11-04]
+ - Gisle noticed a mistake (using HAS_NANOSLEEP) in 1.79
+
+1.79 [2005-11-03]
+ - try nanosleep for emulating usleep -- may help in some weird
+ embedded realtime places which have nanosleep but neither usleep
+ nor select nor poll (doesn't have to be weird embedded realtime
+ place, though -- in many places usleep is nanosleep anyway)
+ - try poll for emulating usleep -- this may help some obscure/old
+ SVR4 places that have neither usleep nor select
+ - a redundant test guard in HiRes.t
+
+1.78 [2005-11-03]
+ - ITIMER_VIRTUAL detection in HiRes.t had problems (that we cannot
+ in the general case fail already at 'use' phase is suboptimal)
+ - fixes to the documentation of clock_gettime() and clock_getres()
+
+1.77 [2005-11-03]
+ - add support for the POSIX clock_gettime() and clock_getres(),
+ if available, either as library calls or as syscalls
+ - be more defensive about missing functionality: break out
+ early (during 'use') if no e.g. clock_getres() is available,
+ and protect our back by trapping those cases also in HiRes.xs
+ - the test added in 1.76 could cause an endless loop e.g. in Solaris,
+ due to mixing of sleep() and alarm() (bad programmer, no cookie!)
+
+1.76 [2005-10-22]
+ - testing for nanosleep had wrong logic which caused nanosleep
+ to become undefined for e.g. Mac OS X
+ - added a test for a core dump that was introduced by Perl 5.8.0
+ safe signals and was fixed for the time of 5.8.1 (one report of
+ the core dump was [perl #20920]), the test skipped pre-5.8.1.
+ - *cough* s/unanosleep/nanosleep/g; *cough*
+
+1.75 [2005-10-18]
+ - installation patch from Gisle Aas: in Perls 5.8.x and later
+ use MakeMaker INSTALLDIRS value of 'perl' instead of 'site'.
+
+1.74 [2005-09-19]
+ - [cpan #14608] Solaris 8 perl 5.005_03 File::Spec module does not have method rel2abs
+ (the workaround is not to use rel2abs, should not be necessary)
+ - [cpan #14642] U2time wrongly exported on the C API
+ (patch supplied by the reporter, SALVA at cpan.org)
+ - add release dates to Changes
+
+1.73 [2005-08-16]
+ - Time::HiRes::nanosleep support for Solaris [PATCH]
(POSIX::uname() not available if building with core perl,
from Gisle Aas, via perl5-porters, perl change #25295)
-1.72 - going back to the 1.68 loader setup (using DynaLoader)
+1.72 [2005-07-01]
+ - going back to the 1.68 loader setup (using DynaLoader)
since too many weird things starting breaking
- fix a typo in José Auguste-Etienne's name
-1.71 - a thinko in the nanosleep() detection
+1.71 [2005-06-28]
+ - a thinko in the nanosleep() detection
- move more changes stuff from the README to Changes
- add -w to the Makefile.PL
-1.70 - oops in 1.69 about @ISA (not affecting anything but silly)
+1.70 [2005-06-26]
+ - oops in 1.69 about @ISA (not affecting anything but silly)
- add copyright 2005 to HiRes.pm
- add copyright and license to HiRes.xs
- add copyrights 2003, 2004, 2005 to README
-1.69 - actually run a test for nanosleep
+1.69 [2005-06-25]
+ - actually run a test for nanosleep
(if there is no $Config{d_nanosleep}) since e.g. in AIX 4.2
it seems that one can link in nanosleep() but then calling
it fails instantly and sets errno to ENOSYS (Not implemented).
@@ -35,7 +131,7 @@
(from Alexey Tourbin)
- add SEE ALSO (BSD::Resource and Time::TAI64)
-1.68
+1.68 [2005-05-14]
- somehow 1.67 had a lot of doubled lines (a major cut-and-paste
error suspected), but miraculously it still worked since the
doubling took place below the __END__ token
@@ -44,20 +140,22 @@
(part of perl change #24271)
- minor doc tweaks
-1.67
+1.67 [2005-05-04]
- (internal) don't ignore the return value of gettimeofday()
- (external) return undef or an empty if the C gettimeofday() fails
(affects Time::HiRes gettimeofday() and the hires time())
-1.66
+1.66 [2004-12-19]
- 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
+ - close also [rt.cpan.org #5933] "Time::HiRes::time does not
+ pick up time adjustments like ntp" since ever reproducing it
+ (and therefore verifying a possible fix) in the same environment
has become rather unlikely
-1.65
+1.65 [2004-09-18]
- one should not mix u?alarm and sleep (the tests modified
by 1.65, #12 and #13, hung in Solaris), now we just busy
loop executing an empty block
@@ -65,7 +163,7 @@
sleeps and alarms
- small spelling fixes
-1.64
+1.64 [2004-09-16]
- regenerate ppport.h with Devel::PPPort 3.03,
now the MY_CXT_CLONE is defined in ppport.h,
we no more need to do that.
@@ -75,11 +173,11 @@
changed to sleep(1)s, the tests still pass but no hang after
a few hundred repeats.
-1.63
+1.63 [2004-09-01]
- Win32 and any ithread build: ppport.h didn't define
MY_CXT_CLONE, which seems to be a Time-HiResism.
-1.62
+1.62 [2004-08-31]
- Skip testing if under PERL_CORE and Time::HiRes has not
been Configured (from Marcus Holland-Moritz, core change
#23246)
@@ -91,13 +189,13 @@
- Can't use newSVpvf for <= 5.003.
(most of the changes from Marcus)
-1.61
+1.61 [2004-08-21]
- Win32: reset reading from the performance counters every
five minutes to better track wall clock time (thanks to
PC timers being often quite bad), should help long-running
programs.
-1.60
+1.60 [2004-08-15]
- Win32: Patch from Steve Hay
[PATCH] Re: [perl #30755] [Win32] Different results from Time::HiRes::gettimeofdayunder the debugger
to [perl #30755] reported by Nigel Sandever
@@ -110,50 +208,50 @@
after that keep using -lrt, patch from Alan Burlison,
bug reported in [cpan #7165]
-1.59
+1.59 [2004-04-08]
- Change the Win32 recalibration limit to 0.5 seconds and tweak
the documentation to blather less about the gory details of the
Win32 implementation and more about the complications in general
of meddling with the system clock.
-1.58
+1.58 [2004-04-08]
- Document the 1.57 change better.
-1.57
+1.57 [2004-07-04]
- Win32/Cygwin/MinGW: if the performance counter drifts by more
than two seconds from the system clock (due to ntp adjustments,
for example), recalibrate our internal counter: from Jan Dubois,
based on [cpan #5933] by Jerry D. Hedden.
-1.56
+1.56 [2004-29-02]
- Give a clearer message if the tests timeout (perl change #22253)
- Don't use /tmp or its moral equivalents (perl bug #15036,
perl change #22258)
-1.55
+1.55 [2004-01-14]
- Windows: mingw32 patch from Mike Pomraning (use Perl's Const64()
instead of VC-specific i64 suffix)
-1.54
+1.54 [2003-12-31]
- Solaris: like Tru64 (dec_osf) also Solaris need -lrt for nanosleep
-1.53
+1.53 [2003-12-30]
- Windows: higher resolution time() by using the Windows
performance counter API, from Jan Dubois and Anton Shcherbinin.
The exact new higher resolution depends on the hardware,
but it should be quite a bit better than using the basic
Windows timers.
-1.52
+1.52 [2003-10-28]
- In AIX (v?) with perl 5.6.1 the HiRes.t can hang after
the subtest 18. No known analysis nor fix, but added
an alarm (that requires fork() and alarm()) to the test.
-1.51
+1.51 [2003-09-22]
- doc tweaks from mjd (perl change #20456)
- NCR MP-RAS hints file added (svr4.pl) (perl change #21249)
-1.50
+1.50 [2003-08-02]
- add a message (for non-core builds) to Makefile.PL about
the LC_ALL=C workaround
- &Time::HiRes::d_nanosleep was broken (perl change #20131)
@@ -163,47 +261,47 @@
- MPE/iX tweak (perl change #20042)
- do not use HAS_NANOSLEEP (perl change #19898)
-1.49
+1.49 [2003-06-23]
- UVuf for non-IVSIZE platforms (from Keiichiro Nagano)
- OS/2 can always mix subsecond sleeps with signals
(part of perl change #19789)
-1.48
+1.48 [2003-06-04]
- workaround for buggy gcc 2.95.3 in openbsd/sparc64
(perl change #19592)
-1.47
+1.47 [2003-05-03]
- do not use -lrt in Linux (from March Lehmann, perl change #19449)
- unnecessary (nanosleep is in libc anyway)
- harmful (-lrt slows down execution)
- incompatible (with many distributions' pthreads)
-1.46
+1.46 [2003-04-25]
- do not create files in blib directories under core
(perl change #19160, from rgs)
- detypo s/VTLARM/VTARLM/ (perl change #19328, from mjd)
-1.45
+1.45 [2003-04-01]
- guarantee that $xdefine in HiRes.t is always defined
(perl change #19109, from IlyaZ)
- a cleaner way to detect PERL_CORE (perl change #19111,
from IlyaZ)
-1.44
+1.44 [2003-03-30]
- add hints/irix.pl to turn off overly POSIX flags that
cause hide struct timespec to be hidden (and compilation
to fail) (bleadperl change #19085)
- documentation tweaks
-1.43
+1.43 [2003-03-11]
- add c:/temp to the list of temp directories to probe
so that cygwin (and win*?) builds are happy. This was
needed at least in my cygwin 1.3.20/w2k setup.
-1.42
+1.42 [2003-01-07]
- modernize the constants code (from Nicholas Clark)
-1.41
+1.41 [2003-01-03]
- At some point the ability to figure our the correct incdir
for EXTERN.h (either a core perl build, or an installed perl)
had broken (which lead into all test compiles failing with
@@ -213,7 +311,7 @@
Now stole a trick from the Encode that sets $ENV{PERL_CORE}
right, and both styles of build should work again.
-1.40
+1.40 [2003-01-03]
- Nicholas Clark noticed that the my_catdir() emulation function
was broken (which means that we didn't really work for Perls
5.002 and 5.003)
@@ -221,16 +319,16 @@
and strict clean
- tightened up the Makefile.PL output, less whitespace
-1.39
+1.39 [2003-10-20]
- fix from Craig Berry for better building in VMS with PERL_CORE
-1.38
+1.38 [2003-10-13]
- no functional changes
- move lib/Time/HiRes.pm as Hires.pm
- libraries scanning was slightly broken (always scanned
for a library even when $Config{libs} already had it)
-1.37
+1.37 [2003-09-23]
- Ray Zimmerman ran into a race condition in Mac OS X.
A 0.01-second alarm fired before the test expected.
The test first slept indefinitely (blocking for signals)
@@ -241,7 +339,7 @@
environment variable VERBOSE to a true value to see the
details (the probing command and the possible errors)
-1.36
+1.36 [2003-09-12]
- do not clear MAN3PODS in Makefile.PL (Radoslaw Zielinski)
- INSTALLDIRS => 'perl' missing which means that Time::HiRes
cannot be upgraded from CPAN to override the 5.8.0 version
@@ -251,19 +349,19 @@
if $ENV{PERL_CORE} (Hugo van der Sanden)
- add documentation about the restart of select() under alarm()
-1.35
+1.35 [2003-08-24]
- small documentation tweaks
-1.34
+1.34 [2003-08-22]
- better VMS operation (Craig Berry)
-1.33
+1.33 [2003-08-20]
- our time machine is accelerating: now works with Perl 5.004_01
(tried with 5.003_07 and 5.002 but I get segmentation faults
from running the Makefile.PL with those in Tru64 4.0D)
-1.32
+1.32 [2003-08-20]
- backward compatibility (pre-5.6.0) tweaks:
- no XSLoader in 5.00503, use DynaLoader instead
- no SvPV_nolen, either
@@ -278,7 +376,7 @@
(since older Perl do not have them in %Config, and even
5.8.0 does not probe for nanosleep)
-1.31
+1.31 [2003-08-19]
- backward compatibility (pre-5.6.1) tweaks:
- define NV if no NVTYPE
- define IVdf if needed (note: the Devel::PPPort
@@ -291,7 +389,7 @@
back to Perl 5.00404), and using nanosleep() (if available) for
subsecond sleeps.
-1.30
+1.30 [2003-08-16]
- release 1.29_02 as 1.30
@@ -303,18 +401,18 @@
version. Note also that in 1.30 Wegscheid turns over the maintenance
to Jarkko Hietaniemi.
-1.29_02
+1.29_02 [2003-08-16]
- fix a silly unclosed comment typo in HiRes.xs
- document and export REALTIME_REALPROF (Solaris)
-1.29_01
+1.29_01 [2003-08-16]
- only getitimer(ITIMER_REAL) available in Cygwin and Win32
(need to patch this also in Perl 5.[89])
- remove CVS revision log from HiRes.xs
-1.29_00
+1.29_00 [2003-08-14]
The following numbered patches refer to the Perl 5.7 changes,
you can browse them at http://public.activestate.com/cgi-bin/perlbrowse
Modified: orca/trunk/packages/Time-HiRes-1.83/HiRes.pm
==============================================================================
--- /orca/trunk/packages/Time-HiRes-1.73/HiRes.pm (original)
+++ orca/trunk/packages/Time-HiRes-1.83/HiRes.pm Thu Dec 1 21:13:32 2005
@@ -10,20 +10,24 @@
@EXPORT = qw( );
@EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
- getitimer setitimer nanosleep
+ getitimer setitimer nanosleep clock_gettime clock_getres
+ CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID
+ CLOCK_REALTIME CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY
ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF
d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
- d_nanosleep);
+ d_nanosleep d_clock_gettime d_clock_getres);
-$VERSION = '1.73';
+$VERSION = '1.83';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
sub AUTOLOAD {
my $constname;
($constname = $AUTOLOAD) =~ s/.*:://;
+ # print "AUTOLOAD: constname = $constname ($AUTOLOAD)\n";
die "&Time::HiRes::constant not defined" if $constname eq 'constant';
my ($error, $val) = constant($constname);
+ # print "AUTOLOAD: error = $error, val = $val\n";
if ($error) {
my (undef,$file,$line) = caller;
die "$error at $file line $line.\n";
@@ -35,6 +39,21 @@
goto &$AUTOLOAD;
}
+sub import {
+ my $this = shift;
+ for my $i (@_) {
+ if (($i eq 'clock_getres' && !&d_clock_getres) ||
+ ($i eq 'clock_gettime' && !&d_clock_gettime) ||
+ ($i eq 'nanosleep' && !&d_nanosleep) ||
+ ($i eq 'usleep' && !&d_usleep) ||
+ ($i eq 'ualarm' && !&d_ualarm)) {
+ require Carp;
+ Carp::croak("Time::HiRes::$i(): unimplemented in this platform");
+ }
+ }
+ Time::HiRes->export_to_level(1, $this, @_);
+}
+
bootstrap Time::HiRes;
# Preloaded methods go here.
@@ -57,7 +76,8 @@
=head1 SYNOPSIS
- use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep );
+ use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep
+ clock_gettime clock_getres );
usleep ($microseconds);
nanosleep ($nanoseconds);
@@ -85,6 +105,9 @@
setitimer ($which, $floating_seconds, $floating_interval );
getitimer ($which);
+ $realtime = clock_gettime(CLOCK_REALTIME);
+ $resolution = clock_getres(CLOCK_REALTIME);
+
=head1 DESCRIPTION
The C<Time::HiRes> module implements a Perl interface to the
@@ -97,10 +120,10 @@
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()>,
-C<Time::HiRes::nanosleep()>, or C<Time::HiRes::sleep()>. If your
-system lacks both C<ualarm()> and C<setitimer()> you don't get
+If your system lacks all of C<nanosleep()>, C<usleep()>,
+C<select()>, and C<poll>, 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
@@ -174,7 +197,8 @@
or more than the core C<time()>, depending on whether your platform
rounds the higher resolution timer values up, down, or to the nearest second
to get the core C<time()>, but naturally the difference should be never
-more than half a second.
+more than half a second. See also L</clock_getres>, if available
+in your system.
B<NOTE 2>: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT, when
the C<time()> seconds since epoch rolled over to 1_000_000_000, the
@@ -267,6 +291,27 @@
In list context, both the remaining time and the interval are returned.
The interval is always what you put in using C<setitimer()>.
+=item clock_gettime ( $which )
+
+Return as seconds the current value of the POSIX high resolution timer
+specified by C<$which>. All implementations that support POSIX high
+resolution timers are supposed to support at least the C<$which> value
+of C<CLOCK_REALTIME>, which is supposed to return results close to the
+results of C<gettimeofday>, or the number of seconds since 00:00:00:00
+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<CLOCK_MONOTONIC>, which guarantees a monotonically increasing time
+value (unlike time(), which can be adjusted). See your system
+documentation for other possibly supported values.
+
+=item clock_getres ( $which )
+
+Return as seconds the resolution of the POSIX high resolution timer
+specified by C<$which>. All implementations that support POSIX high
+resolution timers are supposed to support at least the C<$which> value
+of C<CLOCK_REALTIME>, see L</clock_gettime>.
+
=back
=head1 EXAMPLES
@@ -274,13 +319,13 @@
use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);
$microseconds = 750_000;
- usleep $microseconds;
+ usleep($microseconds);
# signal alarm in 2.5s & every .1s thereafter
- ualarm 2_500_000, 100_000;
+ ualarm(2_500_000, 100_000);
# get seconds and microseconds since the epoch
- ($s, $usec) = gettimeofday;
+ ($s, $usec) = gettimeofday();
# measure elapsed time
# (could also do by subtracting 2 gettimeofday return values)
@@ -315,6 +360,12 @@
$SIG{VTALRM} = sub { print time, "\n" };
setitimer(ITIMER_VIRTUAL, 10, 2.5);
+ use Time::HiRes qw( clock_gettime clock_getres CLOCK_REALTIME );
+ # Read the POSIX high resolution timer.
+ my $high = clock_getres(CLOCK_REALTIME);
+ # But how accurate we can be, really?
+ my $reso = clock_getres(CLOCK_REALTIME);
+
=head1 C API
In addition to the perl API described above, a C API is available for
@@ -324,7 +375,7 @@
name C prototype
--------------- ----------------------
Time::NVtime double (*)()
- Time::U2time void (*)(UV ret[2])
+ Time::U2time void (*)(pTHX_ UV ret[2])
Both functions return equivalent information (like C<gettimeofday>)
but with different representations. The names C<NVtime> and C<U2time>
@@ -365,10 +416,15 @@
platforms like Cygwin and MinGW) the Time::HiRes::time() may temporarily
drift off from the system clock (and the original time()) by up to 0.5
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).
=head1 SEE ALSO
-L<BSD::Resource>, L<Time::TAI64>.
+Perl modules L<BSD::Resource>, L<Time::TAI64>.
+
+Your system documentation for C<clock_gettime>, C<clock_settime>,
+C<gettimeofday>, C<getitimer>, C<setitimer>, C<ualarm>.
=head1 AUTHORS
Modified: orca/trunk/packages/Time-HiRes-1.83/HiRes.xs
==============================================================================
--- /orca/trunk/packages/Time-HiRes-1.73/HiRes.xs (original)
+++ orca/trunk/packages/Time-HiRes-1.83/HiRes.xs Thu Dec 1 21:13:32 2005
@@ -30,6 +30,9 @@
# include <sys/select.h>
# endif
#endif
+#if defined(TIME_HIRES_CLOCK_GETTIME_SYSCALL) || defined(TIME_HIRES_CLOCK_GETRES_SYSCALL)
+#include <syscall.h>
+#endif
#ifdef __cplusplus
}
#endif
@@ -62,7 +65,17 @@
# endif
#endif
-#include "const-c.inc"
+#if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC)
+
+/* HP-UX has CLOCK_XXX values but as enums, not as defines.
+ * The only way to detect these would be to test compile for each. */
+# ifdef __hpux
+# define CLOCK_REALTIME CLOCK_REALTIME
+# define CLOCK_VIRTUAL CLOCK_VIRTUAL
+# define CLOCK_PROFILE CLOCK_PROFILE
+# endif /* # ifdef __hpux */
+
+#endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) */
#if defined(WIN32) || defined(CYGWIN_WITH_W32API)
@@ -358,14 +371,16 @@
/* Do not use H A S _ N A N O S L E E P
- * so that Perl Configure doesn't scan for it.
+ * so that Perl Configure doesn't scan for it (and pull in -lrt and
+ * the like which are not usually good ideas for the default Perl).
+ * (We are part of the core perl now.)
* The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */
#if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
#define HAS_USLEEP
-#define usleep hrt_unanosleep /* could conflict with ncurses for static build */
+#define usleep hrt_nanosleep /* could conflict with ncurses for static build */
void
-hrt_unanosleep(unsigned long usec) /* This is used to emulate usleep. */
+hrt_nanosleep(unsigned long usec) /* This is used to emulate usleep. */
{
struct timespec res;
res.tv_sec = usec/1000/1000;
@@ -405,6 +420,33 @@
}
#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 tsa;
+ tsa.tv_sec = usec * 1000; /* Ignoring wraparound. */
+ tsa.tv_nsec = 0;
+ nanosleep(&tsa, 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 */
+
+void
+hrt_usleep(unsigned long usec)
+{
+ int msec = usec / 1000;
+ poll(0, 0, msec);
+}
+
+#endif /* #if !defined(HAS_USLEEP) && defined(HAS_POLL) */
#if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
#define HAS_UALARM
@@ -646,6 +688,8 @@
#endif /* #ifdef HAS_GETTIMEOFDAY */
+#include "const-c.inc"
+
MODULE = Time::HiRes PACKAGE = Time::HiRes
PROTOTYPES: ENABLE
@@ -658,10 +702,8 @@
#ifdef ATLEASTFIVEOHOHFIVE
#ifdef HAS_GETTIMEOFDAY
{
- UV auv[2];
hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0);
- if (myU2time(aTHX_ auv) == 0)
- hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) auv[0]), 0);
+ hv_store(PL_modglobal, "Time::U2time", 12, newSViv(PTR2IV(myU2time)), 0);
}
#endif
#endif
@@ -741,6 +783,15 @@
OUTPUT:
RETVAL
+#else /* #if defined(TIME_HIRES_NANOSLEEP) */
+
+NV
+nanosleep(nseconds)
+ NV nseconds
+ CODE:
+ croak("Time::HiRes::nanosleep(): unimplemented in this platform");
+ RETVAL = 0.0;
+
#endif /* #if defined(TIME_HIRES_NANOSLEEP) */
NV
@@ -780,6 +831,15 @@
OUTPUT:
RETVAL
+#else /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
+
+NV
+usleep(useconds)
+ NV useconds
+ CODE:
+ croak("Time::HiRes::usleep(): unimplemented in this platform");
+ RETVAL = 0.0;
+
#endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
#ifdef HAS_UALARM
@@ -809,6 +869,24 @@
OUTPUT:
RETVAL
+#else
+
+int
+ualarm(useconds,interval=0)
+ int useconds
+ int interval
+ CODE:
+ croak("Time::HiRes::ualarm(): unimplemented in this platform");
+ RETVAL = -1;
+
+NV
+alarm(seconds,interval=0)
+ NV seconds
+ NV interval
+ CODE:
+ croak("Time::HiRes::alarm(): unimplemented in this platform");
+ RETVAL = 0.0;
+
#endif /* #ifdef HAS_UALARM */
#ifdef HAS_GETTIMEOFDAY
@@ -936,4 +1014,63 @@
#endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
+#if defined(TIME_HIRES_CLOCK_GETTIME)
+
+NV
+clock_gettime(clock_id = CLOCK_REALTIME)
+ int clock_id
+ PREINIT:
+ struct timespec ts;
+ int status = -1;
+ CODE:
+#ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL
+ status = syscall(SYS_clock_gettime, clock_id, &ts);
+#else
+ status = clock_gettime(clock_id, &ts);
+#endif
+ RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1;
+
+ OUTPUT:
+ RETVAL
+
+#else /* if defined(TIME_HIRES_CLOCK_GETTIME) */
+
+NV
+clock_gettime(clock_id = 0)
+ int clock_id
+ CODE:
+ croak("Time::HiRes::clock_gettime(): unimplemented in this platform");
+ RETVAL = 0.0;
+
+#endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) */
+
+#if defined(TIME_HIRES_CLOCK_GETRES)
+
+NV
+clock_getres(clock_id = CLOCK_REALTIME)
+ int clock_id
+ PREINIT:
+ int status = -1;
+ struct timespec ts;
+ CODE:
+#ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL
+ status = syscall(SYS_clock_getres, clock_id, &ts);
+#else
+ status = clock_getres(clock_id, &ts);
+#endif
+ RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1;
+
+ OUTPUT:
+ RETVAL
+
+#else /* if defined(TIME_HIRES_CLOCK_GETRES) */
+
+NV
+clock_getres(clock_id = 0)
+ int clock_id
+ CODE:
+ croak("Time::HiRes::clock_getres(): unimplemented in this platform");
+ RETVAL = 0.0;
+
+#endif /* #if defined(TIME_HIRES_CLOCK_GETRES) */
Modified: orca/trunk/packages/Time-HiRes-1.83/META.yml
==============================================================================
--- /orca/trunk/packages/Time-HiRes-1.73/META.yml (original)
+++ orca/trunk/packages/Time-HiRes-1.83/META.yml Thu Dec 1 21:13:32 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.73
+version: 1.83
version_from: HiRes.pm
installdirs: perl
requires:
Modified: orca/trunk/packages/Time-HiRes-1.83/Makefile.PL
==============================================================================
--- /orca/trunk/packages/Time-HiRes-1.73/Makefile.PL (original)
+++ orca/trunk/packages/Time-HiRes-1.83/Makefile.PL Thu Dec 1 21:13:32 2005
@@ -1,7 +1,7 @@
#!/usr/bin/perl
#
# In general we trust %Config, but for nanosleep() this trust
-# may be misplaces (it may be linkable but not really functional).
+# may be misplaced (it may be linkable but not really functional).
# Use $ENV{FORCE_NANOSLEEP_SCAN} to force rescanning whether there
# really is hope.
@@ -15,6 +15,7 @@
my $DEFINE;
my $LIBS = [];
my $XSOPT = '';
+my $SYSCALL_H;
use vars qw($self); # Used in 'sourcing' the hints.
@@ -141,19 +142,24 @@
my $tmp_exe = "$tmp$ld_exeext";
printf "cccmd = $cccmd\n" if $VERBOSE;
my $res = system($cccmd);
- $ok = defined($res) && $res==0 && -s $tmp_exe && -x _;
+ $ok = defined($res) && $res == 0 && -s $tmp_exe && -x _;
if ( $ok && exists $args{run} && $args{run}) {
- my $abs_tmp_exe =
- File::Spec->
- catfile(File::Spec->rel2abs(File::Spec->curdir),
- $tmp_exe);
- printf "Running $abs_tmp_exe..." if $VERBOSE;
- if (system($abs_tmp_exe) == 0) {
+ my $tmp_exe =
+ File::Spec->catfile(File::Spec->curdir, $tmp_exe);
+ printf "Running $tmp_exe..." if $VERBOSE;
+ if (system($tmp_exe) == 0) {
$ok = 1;
} else {
$ok = 0;
- print "[ system('$abs_tmp_exe') failed: status $? ] ";
+ my $errno = $? >> 8;
+ local $! = $errno;
+ printf <<EOF;
+
+*** The test run of '$tmp_exe' failed: status $?
+*** (the status means: errno = $errno or '$!')
+*** DO NOT PANIC: this just means that *some* functionality will be missing.
+EOF
}
}
unlink("$tmp.c", $tmp_exe);
@@ -224,7 +230,7 @@
}
sub has_nanosleep {
- print "Trying out nanosleep... ";
+ print "testing... ";
return 1 if
try_compile_and_link(<<EOM, run => 1);
#include <time.h>
@@ -243,7 +249,7 @@
ts2.tv_sec = 0;
ts2.tv_nsec = 0;
errno = 0;
- ret = nanosleep(&ts1, &ts2); /* E.g. in AIX nanosleep() fail and set errno to ENOSYS. */
+ ret = nanosleep(&ts1, &ts2); /* E.g. in AIX nanosleep() fails and sets errno to ENOSYS. */
ret == 0 ? exit(0) : exit(errno ? errno : -1);
}
EOM
@@ -266,6 +272,43 @@
return 0;
}
+sub has_clock_x_syscall {
+ my $x = shift;
+ return 0 unless defined $SYSCALL_H;
+ return 1 if
+ try_compile_and_link(<<EOM, run => 1);
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <$SYSCALL_H>
+int main _((int argc, char** argv, char** env))
+{
+ struct timespec ts;
+ /* Many Linuxes get ENOSYS even though the syscall exists. */
+ /* All implementations are supposed to support CLOCK_REALTIME. */
+ int ret = syscall(SYS_clock_$x, CLOCK_REALTIME, &ts);
+ ret == 0 ? exit(0) : exit(errno ? errno : -1);
+}
+EOM
+}
+
+sub has_clock_x {
+ my $x = shift;
+ return 1 if
+ try_compile_and_link(<<EOM, run => 1);
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+int main _((int argc, char** argv, char** env))
+{
+ struct timespec ts;
+ int ret = clock_$x(CLOCK_REALTIME, &ts); /* Many Linuxes get ENOSYS. */
+ /* All implementations are supposed to support CLOCK_REALTIME. */
+ ret == 0 ? exit(0) : exit(errno ? errno : -1);
+}
+EOM
+}
+
sub init {
my $hints = File::Spec->catfile("hints", "$^O.pl");
if (-f $hints) {
@@ -280,6 +323,25 @@
$DEFINE = '';
+ if ($Config{d_syscall}) {
+ print "Have syscall()... looking for syscall.h... ";
+ if (has_include('syscall.h')) {
+ $SYSCALL_H = 'syscall.h';
+ } elsif (has_include('sys/syscall.h')) {
+ $SYSCALL_H = 'sys/syscall.h';
+ }
+ } else {
+ print "No syscall()...\n";
+ }
+
+ if ($Config{d_syscall}) {
+ if (defined $SYSCALL_H) {
+ print "found <$SYSCALL_H>.\n";
+ } else {
+ print "NOT found.\n";
+ }
+ }
+
print "Looking for gettimeofday()... ";
my $has_gettimeofday;
if (exists $Config{d_gettimeod}) {
@@ -385,16 +447,27 @@
print "Looking for nanosleep()... ";
my $has_nanosleep;
- if (exists $Config{d_nanosleep} && !$ENV{FORCE_NANOSLEEP_SCAN}) {
- # Believe $Config{d_nanosleep}.
+ if ($ENV{FORCE_NANOSLEEP_SCAN}) {
+ print "forced scan... ";
+ if (has_nanosleep()) {
+ $has_nanosleep++;
+ $DEFINE .= ' -DTIME_HIRES_NANOSLEEP';
+ }
+ }
+ elsif (exists $Config{d_nanosleep}) {
+ print "believing \$Config{d_nanosleep}... ";
if ($Config{d_nanosleep}) {
$has_nanosleep++;
$DEFINE .= ' -DTIME_HIRES_NANOSLEEP';
}
- } elsif ($^O ne 'mpeix' && # MPE/iX falsely finds nanosleep.
- has_nanosleep()) {
- $has_nanosleep++;
- $DEFINE .= ' -DTIME_HIRES_NANOSLEEP';
+ } elsif ($^O =~ /^(mpeix)$/) {
+ # MPE/iX falsely finds nanosleep from its libc equivalent.
+ print "skipping because in $^O... ";
+ } else {
+ if (has_nanosleep()) {
+ $has_nanosleep++;
+ $DEFINE .= ' -DTIME_HIRES_NANOSLEEP';
+ }
}
if ($has_nanosleep) {
@@ -408,6 +481,50 @@
print "(It would not be portable anyway.)\n";
}
+ print "Looking for clock_gettime()... ";
+ my $has_clock_gettime;
+ if (exists $Config{d_clock_gettime}) {
+ $has_clock_gettime++ if $Config{d_clock_gettime}; # Unlikely...
+ } elsif (has_clock_x('gettime')) {
+ $has_clock_gettime++;
+ $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME';
+ } elsif (defined $SYSCALL_H && has_clock_x_syscall('gettime')) {
+ $has_clock_gettime++;
+ $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME -DTIME_HIRES_CLOCK_GETTIME_SYSCALL';
+ }
+
+ if ($has_clock_gettime) {
+ if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETTIME_SYSCALL/) {
+ print "found (via syscall).\n";
+ } else {
+ print "found.\n";
+ }
+ } else {
+ print "NOT found.\n";
+ }
+
+ print "Looking for clock_getres()... ";
+ my $has_clock_getres;
+ if (exists $Config{d_clock_getres}) {
+ $has_clock_getres++ if $Config{d_clock_getres}; # Unlikely...
+ } elsif (has_clock_x('getres')) {
+ $has_clock_getres++;
+ $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES';
+ } elsif (defined $SYSCALL_H && has_clock_x_syscall('getres')) {
+ $has_clock_getres++;
+ $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES -DTIME_HIRES_CLOCK_GETRES_SYSCALL';
+ }
+
+ if ($has_clock_getres) {
+ if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETRES_SYSCALL/) {
+ print "found (via syscall).\n";
+ } else {
+ print "found.\n";
+ }
+ } else {
+ print "NOT found.\n";
+ }
+
my $has_w32api_windows_h;
if ($^O eq 'cygwin') {
print "Looking for <w32api/windows.h>... ";
@@ -448,9 +565,10 @@
'LIBS' => $LIBS, # e.g., '-lm'
'DEFINE' => $DEFINE, # e.g., '-DHAS_SOMETHING'
'XSOPT' => $XSOPT,
- # do not even think about 'INC' => '-I/usr/ucbinclude', Solaris will avenge.
+ # Do not even think about 'INC' => '-I/usr/ucbinclude',
+ # Solaris will avenge.
'INC' => '', # e.g., '-I/usr/include/other'
- 'INSTALLDIRS' => 'perl',
+ 'INSTALLDIRS' => ($] >= 5.008 ? 'perl' : 'site'),
'dist' => {
'CI' => 'ci -l',
'COMPRESS' => 'gzip -9f',
@@ -469,15 +587,20 @@
sub doConstants {
if (eval {require ExtUtils::Constant; 1}) {
- my @names = (qw(ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
+ my @names = (qw(CLOCK_HIGHRES CLOCK_MONOTONIC
+ CLOCK_PROCESS_CPUTIME_ID
+ CLOCK_REALTIME
+ CLOCK_THREAD_CPUTIME_ID
+ CLOCK_TIMEOFDAY
+ ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
ITIMER_REALPROF));
foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
- d_nanosleep)) {
+ d_nanosleep d_clock_gettime d_clock_getres)) {
my $macro = $_;
- if ($macro eq 'd_nanosleep') {
- $macro =~ s/d_(.*)/TIME_HIRES_\U$1/;
+ if ($macro =~ /^(d_nanosleep|d_clock_gettime|d_clock_getres)$/) {
+ $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
} else {
- $macro =~ s/d_(.*)/HAS_\U$1/;
+ $macro =~ s/^d_(.+)/HAS_\U$1/;
}
push @names, {name => $_, macro => $macro, value => 1,
default => ["IV", "0"]};
@@ -509,6 +632,7 @@
if ($^O =~ /Win32/i) {
$DEFINE = '-DSELECT_IS_BROKEN';
$LIBS = [];
+ print "System is $^O, skipping full configure...\n";
} else {
init();
}
@@ -523,7 +647,7 @@
(exists $ENV{LC_CTYPE} && $ENV{LC_CTYPE} =~ /utf-?8/i) ||
(exists $ENV{LANG} && $ENV{LANG} =~ /utf-?8/i)) {
print <<EOM;
-NOTE: if you get an error like this (the line number may vary):
+NOTE: if you get an error like this (the Makefile line number may vary):
Makefile:91: *** missing separator
then set the environment variable LC_ALL to "C" and retry
from scratch (re-run perl "Makefile.PL").
Modified: orca/trunk/packages/Time-HiRes-1.83/fallback/const-c.inc
==============================================================================
--- /orca/trunk/packages/Time-HiRes-1.73/fallback/const-c.inc (original)
+++ orca/trunk/packages/Time-HiRes-1.83/fallback/const-c.inc Thu Dec 1 21:13:32 2005
@@ -19,7 +19,6 @@
#ifndef pTHX_
#define pTHX_ /* 5.6 or later define this for threading support. */
#endif
-
static int
constant_11 (pTHX_ const char *name, IV *iv_return) {
/* When generated this function returned values for the list of names given
@@ -74,7 +73,120 @@
case 'l':
if (memEQ(name, "d_nanosleep", 11)) {
/* ^ */
-#ifdef HAS_NANOSLEEP
+#ifdef TIME_HIRES_NANOSLEEP
+ *iv_return = 1;
+ return PERL_constant_ISIV;
+#else
+ *iv_return = 0;
+ return PERL_constant_ISIV;
+#endif
+ }
+ break;
+ }
+ return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_14 (pTHX_ const char *name, IV *iv_return) {
+ /* When generated this function returned values for the list of names given
+ here. However, subsequent manual editing may have added or removed some.
+ CLOCK_REALTIME ITIMER_VIRTUAL d_clock_getres d_gettimeofday */
+ /* Offset 6 gives the best switch position. */
+ switch (name[6]) {
+ case 'R':
+ if (memEQ(name, "CLOCK_REALTIME", 14)) {
+ /* ^ */
+#ifdef CLOCK_REALTIME
+ *iv_return = CLOCK_REALTIME;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case '_':
+ if (memEQ(name, "ITIMER_VIRTUAL", 14)) {
+ /* ^ */
+#ifdef ITIMER_VIRTUAL
+ *iv_return = ITIMER_VIRTUAL;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case 'i':
+ if (memEQ(name, "d_gettimeofday", 14)) {
+ /* ^ */
+#ifdef HAS_GETTIMEOFDAY
+ *iv_return = 1;
+ return PERL_constant_ISIV;
+#else
+ *iv_return = 0;
+ return PERL_constant_ISIV;
+#endif
+ }
+ break;
+ case 'k':
+ if (memEQ(name, "d_clock_getres", 14)) {
+ /* ^ */
+#ifdef TIME_HIRES_CLOCK_GETRES
+ *iv_return = 1;
+ return PERL_constant_ISIV;
+#else
+ *iv_return = 0;
+ return PERL_constant_ISIV;
+#endif
+ }
+ break;
+ }
+ return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_15 (pTHX_ const char *name, IV *iv_return) {
+ /* When generated this function returned values for the list of names given
+ here. However, subsequent manual editing may have added or removed some.
+ CLOCK_MONOTONIC CLOCK_TIMEOFDAY ITIMER_REALPROF d_clock_gettime */
+ /* Offset 7 gives the best switch position. */
+ switch (name[7]) {
+ case 'I':
+ if (memEQ(name, "CLOCK_TIMEOFDAY", 15)) {
+ /* ^ */
+#ifdef CLOCK_TIMEOFDAY
+ *iv_return = CLOCK_TIMEOFDAY;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case 'O':
+ if (memEQ(name, "CLOCK_MONOTONIC", 15)) {
+ /* ^ */
+#ifdef CLOCK_MONOTONIC
+ *iv_return = CLOCK_MONOTONIC;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case 'R':
+ if (memEQ(name, "ITIMER_REALPROF", 15)) {
+ /* ^ */
+#ifdef ITIMER_REALPROF
+ *iv_return = ITIMER_REALPROF;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case '_':
+ if (memEQ(name, "d_clock_gettime", 15)) {
+ /* ^ */
+#ifdef TIME_HIRES_CLOCK_GETTIME
*iv_return = 1;
return PERL_constant_ISIV;
#else
@@ -100,14 +212,18 @@
Regenerate these constant functions by feeding this entire source file to
perl -x
-#!/usr/local/bin/perl5.8.0 -w
+#!perl -w
use ExtUtils::Constant qw (constant_types C_constant XS_constant);
my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(ITIMER_PROF ITIMER_REAL ITIMER_REALPROF ITIMER_VIRTUAL),
+my @names = (qw(CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID
+ CLOCK_REALTIME CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY
+ ITIMER_PROF ITIMER_REAL ITIMER_REALPROF ITIMER_VIRTUAL),
+ {name=>"d_clock_getres", type=>"IV", macro=>"TIME_HIRES_CLOCK_GETRES", value=>"1", default=>["IV", "0"]},
+ {name=>"d_clock_gettime", type=>"IV", macro=>"TIME_HIRES_CLOCK_GETTIME", value=>"1", default=>["IV", "0"]},
{name=>"d_getitimer", type=>"IV", macro=>"HAS_GETITIMER", value=>"1", default=>["IV", "0"]},
{name=>"d_gettimeofday", type=>"IV", macro=>"HAS_GETTIMEOFDAY", value=>"1", default=>["IV", "0"]},
- {name=>"d_nanosleep", type=>"IV", macro=>"HAS_NANOSLEEP", value=>"1", default=>["IV", "0"]},
+ {name=>"d_nanosleep", type=>"IV", macro=>"TIME_HIRES_NANOSLEEP", value=>"1", default=>["IV", "0"]},
{name=>"d_setitimer", type=>"IV", macro=>"HAS_SETITIMER", value=>"1", default=>["IV", "0"]},
{name=>"d_ualarm", type=>"IV", macro=>"HAS_UALARM", value=>"1", default=>["IV", "0"]},
{name=>"d_usleep", type=>"IV", macro=>"HAS_USLEEP", value=>"1", default=>["IV", "0"]});
@@ -128,8 +244,8 @@
/* Offset 7 gives the best switch position. */
switch (name[7]) {
case 'm':
- if (memEQ(name, "d_ualarm", 8)) {
- /* ^ */
+ if (memEQ(name, "d_ualar", 7)) {
+ /* m */
#ifdef HAS_UALARM
*iv_return = 1;
return PERL_constant_ISIV;
@@ -140,8 +256,8 @@
}
break;
case 'p':
- if (memEQ(name, "d_usleep", 8)) {
- /* ^ */
+ if (memEQ(name, "d_uslee", 7)) {
+ /* p */
#ifdef HAS_USLEEP
*iv_return = 1;
return PERL_constant_ISIV;
@@ -156,40 +272,36 @@
case 11:
return constant_11 (aTHX_ name, iv_return);
break;
- case 14:
- /* Names all of length 14. */
- /* ITIMER_VIRTUAL d_gettimeofday */
- /* Offset 6 gives the best switch position. */
- switch (name[6]) {
- case '_':
- if (memEQ(name, "ITIMER_VIRTUAL", 14)) {
- /* ^ */
-#ifdef ITIMER_VIRTUAL
- *iv_return = ITIMER_VIRTUAL;
- return PERL_constant_ISIV;
+ case 13:
+ if (memEQ(name, "CLOCK_HIGHRES", 13)) {
+#ifdef CLOCK_HIGHRES
+ *iv_return = CLOCK_HIGHRES;
+ return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ return PERL_constant_NOTDEF;
#endif
- }
- break;
- case 'i':
- if (memEQ(name, "d_gettimeofday", 14)) {
- /* ^ */
-#ifdef HAS_GETTIMEOFDAY
- *iv_return = 1;
- return PERL_constant_ISIV;
+ }
+ break;
+ case 14:
+ return constant_14 (aTHX_ name, iv_return);
+ break;
+ case 15:
+ return constant_15 (aTHX_ name, iv_return);
+ break;
+ case 23:
+ if (memEQ(name, "CLOCK_THREAD_CPUTIME_ID", 23)) {
+#ifdef CLOCK_THREAD_CPUTIME_ID
+ *iv_return = CLOCK_THREAD_CPUTIME_ID;
+ return PERL_constant_ISIV;
#else
- *iv_return = 0;
- return PERL_constant_ISIV;
+ return PERL_constant_NOTDEF;
#endif
- }
- break;
}
break;
- case 15:
- if (memEQ(name, "ITIMER_REALPROF", 15)) {
-#ifdef ITIMER_REALPROF
- *iv_return = ITIMER_REALPROF;
+ case 24:
+ if (memEQ(name, "CLOCK_PROCESS_CPUTIME_ID", 24)) {
+#ifdef CLOCK_PROCESS_CPUTIME_ID
+ *iv_return = CLOCK_PROCESS_CPUTIME_ID;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
Modified: orca/trunk/packages/Time-HiRes-1.83/fallback/const-xs.inc
==============================================================================
--- /orca/trunk/packages/Time-HiRes-1.73/fallback/const-xs.inc (original)
+++ orca/trunk/packages/Time-HiRes-1.83/fallback/const-xs.inc Thu Dec 1 21:13:32 2005
@@ -86,3 +86,4 @@
type, s));
PUSHs(sv);
}
+
Modified: orca/trunk/packages/Time-HiRes-1.83/t/HiRes.t
==============================================================================
--- /orca/trunk/packages/Time-HiRes-1.73/t/HiRes.t (original)
+++ orca/trunk/packages/Time-HiRes-1.83/t/HiRes.t Thu Dec 1 21:13:32 2005
@@ -12,7 +12,7 @@
}
}
-BEGIN { $| = 1; print "1..28\n"; }
+BEGIN { $| = 1; print "1..31\n"; }
END { print "not ok 1\n" unless $loaded }
@@ -24,41 +24,66 @@
use strict;
-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;
+my $have_gettimeofday = &Time::HiRes::d_gettimeofday;
+my $have_usleep = &Time::HiRes::d_usleep;
+my $have_nanosleep = &Time::HiRes::d_nanosleep;
+my $have_ualarm = &Time::HiRes::d_ualarm;
+my $have_clock_gettime = &Time::HiRes::d_clock_gettime;
+my $have_clock_getres = &Time::HiRes::d_clock_getres;
+
+sub has_symbol {
+ my $symbol = shift;
+ eval "use Time::HiRes qw($symbol)";
+ return 0 unless $@ eq '';
+ eval "my \$a = $symbol";
+ return $@ eq '';
+}
+
+printf "# have_gettimeofday = %d\n", $have_gettimeofday;
+printf "# have_usleep = %d\n", $have_usleep;
+printf "# have_nanosleep = %d\n", $have_nanosleep;
+printf "# have_ualarm = %d\n", $have_ualarm;
+printf "# have_clock_gettime = %d\n", $have_clock_gettime;
+printf "# have_clock_getres = %d\n", $have_clock_getres;
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;
+import Time::HiRes 'clock_gettime' if $have_clock_gettime;
+import Time::HiRes 'clock_getres' if $have_clock_getres;
use Config;
+use Time::HiRes qw(gettimeofday);
+
my $have_alarm = $Config{d_alarm};
my $have_fork = $Config{d_fork};
-my $waitfor = 60; # 10 seconds is normal.
-my $pid;
+my $waitfor = 60; # 10-20 seconds is normal (load affects this).
+my $timer_pid;
+my $TheEnd;
if ($have_fork) {
- 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 "# I am timer process $$\n";
+ print "# I am the main process $$, starting the timer process...\n";
+ $timer_pid = fork();
+ if (defined $timer_pid) {
+ if ($timer_pid == 0) { # We are the kid, set up the timer.
+ 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 the testing process\n";
+ warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n";
+ print "# Terminating the main process...\n";
kill('TERM', getppid());
- print "# Timer process exiting\n";
+ print "# This is the timer process $$, over and out.\n";
exit(0);
+ } else {
+ print "# The timer process $timer_pid launched, continuing testing...\n";
+ $TheEnd = time() + $waitfor;
}
} else {
warn "$0: fork failed: $!\n";
}
} else {
- print "# No timer process\n";
+ print "# No timer process (need fork)\n";
}
my $xdefine = '';
@@ -95,7 +120,7 @@
}
}
-if (!$have_gettimeofday) {
+unless ($have_gettimeofday) {
skip 2..6;
}
else {
@@ -114,10 +139,11 @@
ok 6, $f - $two[0] < 2, "$f - $two[0] >= 2";
}
-if (!$have_usleep) {
+unless ($have_usleep) {
skip 7..8;
}
else {
+ use Time::HiRes qw(usleep);
my $one = time;
usleep(10_000);
my $two = time;
@@ -125,7 +151,7 @@
my $three = time;
ok 7, $one == $two || $two == $three, "slept too long, $one $two $three";
- if (!$have_gettimeofday) {
+ unless ($have_gettimeofday) {
skip 8;
}
else {
@@ -143,7 +169,7 @@
ok 9, abs($f - 5.4) < 0.001, $f;
}
-if (!$have_gettimeofday) {
+unless ($have_gettimeofday) {
skip 10;
}
else {
@@ -152,17 +178,17 @@
ok 10, $f < 2, $f;
}
-if (!$have_usleep || !$have_gettimeofday) {
+unless ($have_usleep && $have_gettimeofday) {
skip 11;
}
else {
- my $r = [gettimeofday()];
+ my $r = [ gettimeofday() ];
Time::HiRes::sleep( 0.5 );
my $f = tv_interval $r;
ok 11, $f > 0.4 && $f < 0.9, "slept $f instead of 0.5 secs.";
}
-if (!$have_ualarm || !$have_alarm) {
+unless ($have_ualarm && $have_alarm) {
skip 12..13;
}
else {
@@ -183,7 +209,7 @@
# Did we even get close?
-if (!$have_time) {
+unless ($have_gettimeofday) {
skip 14;
} else {
my ($s, $n, $i) = (0);
@@ -209,7 +235,7 @@
print "ok $_ # Skip: no gettimeofday or no ualarm or no usleep\n";
}
} else {
- use Time::HiRes qw (time alarm sleep);
+ use Time::HiRes qw(time alarm sleep);
my ($f, $r, $i, $not, $ok);
@@ -272,47 +298,49 @@
unless ( defined &Time::HiRes::setitimer
&& defined &Time::HiRes::getitimer
- && eval 'Time::HiRes::ITIMER_VIRTUAL'
- && $Config{d_select}
+ && has_symbol('ITIMER_VIRTUAL')
&& $Config{sig_name} =~ m/\bVTALRM\b/) {
for (18..19) {
print "ok $_ # Skip: no virtual interval timers\n";
}
} else {
- use Time::HiRes qw (setitimer getitimer ITIMER_VIRTUAL);
+ use Time::HiRes qw(setitimer getitimer ITIMER_VIRTUAL);
my $i = 3;
my $r = [Time::HiRes::gettimeofday()];
$SIG{VTALRM} = sub {
- $i ? $i-- : setitimer(ITIMER_VIRTUAL, 0);
+ $i ? $i-- : setitimer(&ITIMER_VIRTUAL, 0);
print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n";
};
print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 0.5, 0.4)), "\n";
# Assume interval timer granularity of $limit * 0.5 seconds. Too bold?
- my $virt = getitimer(ITIMER_VIRTUAL);
+ my $virt = getitimer(&ITIMER_VIRTUAL);
print "not " unless defined $virt && abs($virt / 0.5) - 1 < $limit;
print "ok 18\n";
print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
- while (getitimer(ITIMER_VIRTUAL)) {
+ while (getitimer(&ITIMER_VIRTUAL)) {
my $j;
for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer().
}
print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
- $virt = getitimer(ITIMER_VIRTUAL);
+ $virt = getitimer(&ITIMER_VIRTUAL);
print "not " unless defined $virt && $virt == 0;
print "ok 19\n";
$SIG{VTALRM} = 'DEFAULT';
}
-if ($have_gettimeofday) {
+if ($have_gettimeofday &&
+ $have_usleep) {
+ use Time::HiRes qw(usleep);
+
my ($t0, $td);
my $sleep = 1.5; # seconds
@@ -350,7 +378,7 @@
}
}
-if (!$have_nanosleep) {
+unless ($have_nanosleep) {
skip 22..23;
}
else {
@@ -361,7 +389,7 @@
my $three = CORE::time;
ok 22, $one == $two || $two == $three, "slept too long, $one $two $three";
- if (!$have_gettimeofday) {
+ unless ($have_gettimeofday) {
skip 23;
}
else {
@@ -402,9 +430,128 @@
skip 28;
}
-if (defined $pid) {
- print "# I am process $$, terminating the timer process $pid\n";
- kill('TERM', $pid); # We are done, the timer can go.
- unlink("ktrace.out");
+if ($have_ualarm && $] >= 5.008001) {
+ # http://groups.google.com/group/perl.perl5.porters/browse_thread/thread/adaffaaf939b042e/20dafc298df737f0%2320dafc298df737f0?sa=X&oi=groupsr&start=0&num=3
+ # Perl changes [18765] and [18770], perl bug [perl #20920]
+
+ # First we will find the loop size N (a for() loop 0..N-1)
+ # that will take more than T seconds.
+
+ my $T = 0.01;
+ use Time::HiRes qw(time);
+ my $N = 1024;
+ my $i;
+ N: {
+ do {
+ my $t0 = time();
+ for ($i = 0; $i < $N; $i++) { }
+ my $t1 = time();
+ my $dt = $t1 - $t0;
+ print "# N = $N, t1 = $t1, t0 = $t0, dt = $dt\n";
+ last N if $dt > $T;
+ $N *= 2;
+ } while (1);
+ }
+
+ # The time-burner which takes at least T seconds.
+ my $F = sub {
+ my $c = @_ ? shift : 1;
+ my $n = $c * $N;
+ my $i;
+ for ($i = 0; $i < $n; $i++) { }
+ };
+
+ # Then we will setup a periodic timer (the two-argument alarm() of
+ # Time::HiRes, behind the curtains the libc ualarm()) which has
+ # a signal handler that takes so much time (on the first initial
+ # invocation) that the first periodic invocation (second invocation)
+ # will happen before the first invocation has finished. In Perl 5.8.0
+ # the "safe signals" concept was implemented, with unfortunately at least
+ # one bug that caused a core dump on reentering the handler. This bug
+ # was fixed by the time of Perl 5.8.1.
+
+ # Do not try mixing sleep() and alarm() for testing this.
+
+ my $a = 0; # Number of alarms we receive.
+ my $A = 2; # Number of alarms we will handle before disarming.
+ # (We may well get $A + 1 alarms.)
+
+ $SIG{ALRM} = sub {
+ $a++;
+ print "# Alarm $a - ", time(), "\n";
+ alarm(0) if $a >= $A; # Disarm the alarm.
+ $F->(2); # Try burning CPU at least for 2T seconds.
+ };
+
+ use Time::HiRes qw(alarm);
+ alarm($T, $T); # Arm the alarm.
+
+ $F->(10); # Try burning CPU at least for 10T seconds.
+
+ print "ok 29\n"; # Not core dumping by now is considered to be the success.
+} else {
+ skip 29;
+}
+
+if ($have_clock_gettime &&
+ # All implementations of clock_gettime()
+ # are SUPPOSED TO support CLOCK_REALTIME.
+ has_symbol('CLOCK_REALTIME')) {
+ my $ok = 0;
+ TRY: {
+ for my $try (1..3) {
+ print "# CLOCK_REALTIME: try = $try\n";
+ my $t0 = clock_gettime(&CLOCK_REALTIME);
+ use Time::HiRes qw(sleep);
+ my $T = 1.5;
+ sleep($T);
+ my $t1 = clock_gettime(&CLOCK_REALTIME);
+ if ($t0 > 0 && $t1 > $t0) {
+ print "# t1 = $t1, t0 = $t0\n";
+ my $dt = $t1 - $t0;
+ my $rt = abs(1 - $dt / $T);
+ print "# dt = $dt, rt = $rt\n";
+ if ($rt <= 2 * $limit) {
+ $ok = 1;
+ last TRY;
+ }
+ } else {
+ print "# Error: t0 = $t0, t1 = $t1\n";
+ }
+ my $r = rand() + rand();
+ printf "# Sleeping for %.6f seconds...\n";
+ sleep($r);
+ }
+ }
+ if ($ok) {
+ print "ok 30\n";
+ } else {
+ print "not ok 30\n";
+ }
+} else {
+ print "# No clock_gettime\n";
+ skip 30;
+}
+
+if ($have_clock_getres) {
+ my $tr = clock_getres();
+ if ($tr > 0) {
+ print "ok 31 # tr = $tr\n";
+ } else {
+ print "not ok 31 # tr = $tr\n";
+ }
+} else {
+ print "# No clock_getres\n";
+ skip 31;
+}
+
+END {
+ if (defined $timer_pid) {
+ 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;
+ kill('TERM', $timer_pid); # We are done, the timer can go.
+ unlink("ktrace.out"); # Used in BSD system call tracing.
+ print "# All done.\n";
+ }
}
More information about the Orca-checkins
mailing list