Change 30288 by [EMAIL PROTECTED] on 2007/02/14 15:29:27
Integrate:
[ 27182]
Upgrade to Time-HiRes-1.87
[ 28745]
Upgrade to Time-HiRes-1.88.
[ 28747]
Upgrade to Time-HiRes-1.89.
[ 28748]
Update to Time-HiRes-1.90.
[ 28919]
Upgrade to Time-HiRes-1.91
[ 29010]
Upgrade to Time-HiRes-1.92.
[ 29023]
Upgrade to Time-HiRes-1.93.
[ 29031]
Upgrade to Time-HiRes-1.94.
[ 29181]
Forgot to bump Time-HiRes $VERSION in change #29180
(IO's $VERSION is bumped already)
[ 29423]
Upgrade to Time-HiRes-1.95
[ 29426]
Upgrade to Time-HiRes-1.96.
[ 29428]
Fix Time-HiRes linker error on Win32 introduced by upgrades
from version 1.94 (#29423 and #29426)
Subject: Re: Time::HiRes not happy?
From: "Rafael Garcia-Suarez" <[EMAIL PROTECTED]>
Date: Fri, 1 Dec 2006 10:26:48 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 29478]
Upgrade to Time-HiRes 1.9702
[ 29495]
Upgrade to Time-HiRes-1.9703
[ 29671]
Upgrade to Time-HiRes-1.9704
[ 30157]
Upgrade to Time-HiRes-1.9705
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#330 integrate
... //depot/maint-5.8/perl/ext/Time/HiRes/Changes#26 integrate
... //depot/maint-5.8/perl/ext/Time/HiRes/HiRes.pm#28 integrate
... //depot/maint-5.8/perl/ext/Time/HiRes/HiRes.xs#16 integrate
... //depot/maint-5.8/perl/ext/Time/HiRes/Makefile.PL#30 integrate
... //depot/maint-5.8/perl/ext/Time/HiRes/fallback/const-c.inc#4 integrate
... //depot/maint-5.8/perl/ext/Time/HiRes/hints/aix.pl#1 branch
... //depot/maint-5.8/perl/ext/Time/HiRes/hints/linux.pl#1 branch
... //depot/maint-5.8/perl/ext/Time/HiRes/t/HiRes.t#12 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#330 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#329~30287~ 2007-02-14 07:06:55.000000000 -0800
+++ perl/MANIFEST 2007-02-14 07:29:27.000000000 -0800
@@ -968,9 +968,11 @@
ext/Time/HiRes/Changes Time::HiRes extension
ext/Time/HiRes/fallback/const-c.inc Time::HiRes extension
ext/Time/HiRes/fallback/const-xs.inc Time::HiRes extension
+ext/Time/HiRes/hints/aix.pl Hint for Time::HiRes for named architecture
ext/Time/HiRes/hints/dec_osf.pl Hint for Time::HiRes for named
architecture
ext/Time/HiRes/hints/dynixptx.pl Hint for Time::HiRes for named
architecture
ext/Time/HiRes/hints/irix.pl Hint for Time::HiRes for named architecture
+ext/Time/HiRes/hints/linux.pl Hints for Time::HiRes for named architecture
ext/Time/HiRes/hints/sco.pl Hints for Time::HiRes for named architecture
ext/Time/HiRes/hints/solaris.pl Hints for Time::HiRes for named
architecture
ext/Time/HiRes/hints/svr4.pl Hints for Time::HiRes for named architecture
==== //depot/maint-5.8/perl/ext/Time/HiRes/Changes#26 (text) ====
Index: perl/ext/Time/HiRes/Changes
--- perl/ext/Time/HiRes/Changes#25~26600~ 2006-01-03 05:23:00.000000000
-0800
+++ perl/ext/Time/HiRes/Changes 2007-02-14 07:29:27.000000000 -0800
@@ -1,4 +1,150 @@
-Revision history for Perl extension Time::HiRes.
+Revision history for the Perl extension Time::HiRes.
+
+1.9705 [2007-02-06]
+ - nanosleep() and clock_nanosleep() detection and use were
+ quite broken; in Linux -lrt needed; fixes from Zefram
+ - [internal] slightly cleaner building of $DEFINE in Makefile.PL,
+ should avoid double/conflicting -D flags
+
+1.9704 [2007-01-01]
+ - allow 10% of slop in test #14 (testing difference between
+ CORE::time() and Time::HiRes::time()), there seem to be often
+ transient failures from Perl smoke builds on this test
+ - small pod tweaks
+
+1.9703 [2006-12-08]
+ - use int main(int argc, char **argv) consistently in Makefile.PL,
+ should help with
+ [rt.cpan.org #23868] nanosleep not detected under Mac OS 10.3.9
starting with Time::HiRes 1.96
+ - if someone still has the locale-broken Perl 5.8.0,
+ suggest that they upgrade their Perl
+
+1.9702 [2006-12-06]
+ - restore the -DATLEASTFIVEOHOHFIVE, Win32 needed it still
+
+1.9701 [2006-12-04]
+ - upgrade to ppport.h 3.10_02
+ - remove the -DATLEASTFIVEOHOHFIVE
+ - use the ppport.h PL_ppaddr, PL_statcache, PL_laststatval
+ - use the ppport.h aTHXR for calling Perl stat()
+ - switch into four-digit version since 2.0 is coming up
+ awfully fast but not feeling like a major rewrite
+
+1.97 [2006-11-30]
+ - 1.95 broke building in Win32 (since pp_stat is not exported),
+ figured out how to call an op directly in 5.005 (use Perl_ppaddr
+ instead of PL_ppaddr)
+ - backport to Perl 5.004_05 (requires using statcache
+ and laststatval instead of PL_statcache and PL_laststatval)
+ (also checked to work in 5.005_04, 5.6.1, and 5.8.8 with threads)
+
+1.96 [2006-11-30]
+ - 1.95 broke builds for threaded Perls, rt.cpan.org tickets:
+ [rt.cpan.org #23694] Time::HiRes fails tests on Solaris and Perl 5.6.1
+ [rt.cpan.org #23712] Time-HiRes 1.95 Fails make on AIX 5.2 with Perl
5.8.8
+ [rt.cpan.org #23730] Time::HiRes 1.95 fails make on MacOS X
10.3.9/perl 5.8.8
+ - use main() prototype consistently in Makefile.PL
+
+1.95 [2006-11-29]
+ - integrate core change #29180: Silence VC++ compiler warnings
+ from Steve Hay
+ - do not use PL_ppaddr in stat() because that is not available
+ in Perl 5.005_04
+ - regenerate fallback/*.inc for older Perls without
+ ExtUtils::Constant because of d_hires_stat, resolves
+ [rt.cpan.org #23694] Time::HiRes fails tests on Solaris and Perl 5.6.1
+ - Make Makefile.PL more defensive against false PERL_CORE
+
+1.94 [2006-10-16]
+ - file timestamps oddities seen: the atime and mtime
+ can be out of sync (modify first and read second can leave
+ atime < mtime) and mtime can be subsecond while atime is not.
+ So make the test more forgiving.
+
+1.93 [2006-10-15]
+ - the ualarm() tests (34-37) assumed that ualarm(N)
+ could never alarm in less than N seconds, widened
+ the acceptable relative range to 0.9..1.5. Addresses
+ [rt.cpan.org #22090] and [rt.cpan.org #22091].
+
+ - skip the stat() tests in cygwin and win32, because
+ if run on FAT the timestamp granularity is only 2 seconds.
+ Any good way to detect (cygwin or win32) whether we are
+ being run on NTFS or anywhere with better timestamps?
+ Addresses [rt.cpan.org #22089] and [rt.cpan.org #22098].
+
+1.92 [2006-10-13]
+ - scan for subsecond resolution timestamps in struct stat,
+ some known possibilities:
+
+ (1) struct timespec st_atimespec;
+ st_atimespec.tv_nsec;
+ (2) time_t st_atime;
+ long st_atimensec;
+ (3) time_t st_atime;
+ int st_atime_n;
+ (4) timestruc_t st_atim;
+ st_atim.tv_nsec
+ (5) time_t st_atime;
+ int st_uatime;
+
+ If something like this is found, one can do
+
+ use Time::HiRes;
+ my @stat = Time::HiRes::stat();
+
+ or even override the standard stat():
+
+ use Time::HiRes qw(stat);
+
+ to get the stat() timestamps
+
+ my ($atime, $mtime, $ctime) = @stat[8, 9, 10];
+
+ with subsecond resolution (assuming both the operating
+ system and the filesystem support that kind of thing).
+
+ Contributions for more systems (especially non-UNIX,
+ e.g. but not limited to: Win32, VMS, OS/2) gladly accepted.
+ (also more UNIX variants welcome: HP-UX? IRIX?)
+
+ Thanks to H.Merijn Brand, John Peacock, and Craig
+ Berry for brave beta testing.
+
+1.91 [2006-09-29]
+ - ualarm() in SuSE 10.1 was overflowing after ~4.2 seconds,
+ possibly due to a glibc bug/feature (suspected overflow at
+ 2**32 microseconds?), workaround by using the setitimer()
+ implementation of ualarm() if either useconds or
+ interval > 999_999 (this case seems to vary between systems:
+ are useconds more than 999_999 for ualarm() defined or not)
+ Added more ualarm() tests to catch various overflow points,
+ hopefully no problems in various platforms.
+ (The problem report by Mark Seger and Jon Paul Sullivan of HP.)
+
+1.90 [2006-08-22]
+ - tweak still needed for Const64(), from Jerry Hedden
+ - get a freshly generated ppport.h
+ - update Copyright years
+
+1.89 [2006-08-22]
+ - Const64() already appends an 'LL' (or i64), so provide LL and i64
+ forms for the IV_1E[679] (effects Win32 and Cygwin), reported by
+ Jerry Hedden.
+ - the Changes entry for 1.88 talked about [IN]V_1[679],
+ missing the 'E'.
+
+1.88 [2006-08-21]
+ - clean up the g++ warnings in HiRes.xs, all of them
+ about mixing integer and floating point, introduce
+ constants IV_1E[679] and NV_1E[679]
+
+1.87 [2006-02-13]
+ - [rt.cpan.org #17442] 'make test' frequently fails under
+ Cygwin Perl v5.8.8, reported and patched by J. R. Hedden
+ (two race condition bugs in the END block in the case the
+ main process dies before the timer process, unearthed
+ by a bug in Cygwin ualarm)
1.86 [2005-12-17]
- HiRes.t:s/ok 32/ok 33/, from Dominic Dunlop
==== //depot/maint-5.8/perl/ext/Time/HiRes/HiRes.pm#28 (text) ====
Index: perl/ext/Time/HiRes/HiRes.pm
--- perl/ext/Time/HiRes/HiRes.pm#27~26600~ 2006-01-03 05:23:00.000000000
-0800
+++ perl/ext/Time/HiRes/HiRes.pm 2007-02-14 07:29:27.000000000 -0800
@@ -19,9 +19,11 @@
TIMER_ABSTIME
d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
d_nanosleep d_clock_gettime d_clock_getres
- d_clock d_clock_nanosleep);
+ d_clock d_clock_nanosleep
+ stat
+ );
-$VERSION = '1.86';
+$VERSION = '1.9705';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -83,7 +85,8 @@
=head1 SYNOPSIS
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep
- clock_gettime clock_getres clock_nanosleep clock );
+ clock_gettime clock_getres clock_nanosleep clock
+ stat );
usleep ($microseconds);
nanosleep ($nanoseconds);
@@ -105,20 +108,27 @@
alarm ($floating_seconds);
alarm ($floating_seconds, $floating_interval);
- use Time::HiRes qw( setitimer getitimer
- ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF );
+ use Time::HiRes qw( setitimer getitimer );
setitimer ($which, $floating_seconds, $floating_interval );
getitimer ($which);
+ use Time::HiRes qw( clock_gettime clock_getres clock_nanosleep
+ ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF );
+
$realtime = clock_gettime(CLOCK_REALTIME);
$resolution = clock_getres(CLOCK_REALTIME);
- clock_nanosleep(CLOCK_REALTIME, 1.5);
- clock_nanosleep(CLOCK_REALTIME, time() + 10, TIMER_ABSTIME);
+ clock_nanosleep(CLOCK_REALTIME, 1.5e9);
+ clock_nanosleep(CLOCK_REALTIME, time()*1e9 + 10e9, TIMER_ABSTIME);
my $ticktock = clock();
+ use Time::HiRes qw( stat );
+
+ my @stat = stat("file");
+ my @stat = stat(FH);
+
=head1 DESCRIPTION
The C<Time::HiRes> module implements a Perl interface to the
@@ -152,6 +162,14 @@
with signals, give some thought to whether Perl is the tool you should
be using for work requiring nanosecond accuracies.
+Remember that unless you are working on a I<hard realtime> system,
+any clocks and timers will be imprecise, especially so if you are working
+in a pre-emptive multiuser system. Understand the difference between
+I<wallclock time> and process time (in UNIX-like systems the sum of
+I<user> and I<system> times). Any attempt to sleep for X seconds will
+most probably end up sleeping B<more> than that, but don't be surpised
+if you end up sleeping slightly B<less>.
+
The following functions can be imported from this module.
No functions are exported by default.
@@ -166,9 +184,9 @@
=item usleep ( $useconds )
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. Can
-also sleep for zero seconds, which often works like a I<thread yield>.
+specified. Returns the number of microseconds actually slept.
+Can sleep for more than one second, unlike the C<usleep> system call.
+Can also sleep for zero seconds, which often works like a I<thread yield>.
See also C<Time::HiRes::usleep()>, C<Time::HiRes::sleep()>, and
C<Time::HiRes::clock_nanosleep()>.
@@ -179,8 +197,8 @@
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. Can also sleep for zero seconds, which often works like a
-I<thread yield>. See also C<Time::HiRes::sleep()>,
+one second. Can also sleep for zero seconds, which often works like
+a I<thread yield>. See also C<Time::HiRes::sleep()>,
C<Time::HiRes::usleep()>, and C<Time::HiRes::clock_nanosleep()>.
Do not expect nanosleep() to be exact down to one nanosecond.
@@ -191,6 +209,8 @@
Issues a C<ualarm> call; the C<$interval_useconds> is optional and
will be zero if unspecified, resulting in C<alarm>-like behaviour.
+ualarm(0) will cancel an outstanding ualarm().
+
Note that the interaction between alarms and sleeps is unspecified.
=item tv_interval
@@ -255,7 +275,7 @@
=item setitimer ( $which, $floating_seconds [, $interval_floating_seconds ] )
-Start up an interval timer: after a certain time, a signal arrives,
+Start up an interval timer: after a certain time, a signal ($which) arrives,
and more signals may keep arriving at certain intervals. To disable
an "itimer", use C<$floating_seconds> of zero. If the
C<$interval_floating_seconds> is set to zero (or unspecified), the
@@ -269,7 +289,7 @@
In list context, both the remaining time and the interval are returned.
-There are usually three or four interval timers available: the
+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
@@ -294,7 +314,8 @@
The semantics of interval timers for multithreaded programs are
system-specific, and some systems may support additional interval
-timers. See your C<setitimer()> documentation.
+timers. For example, it is unspecified which thread gets the signals.
+See your C<setitimer()> documentation.
=item getitimer ( $which )
@@ -326,10 +347,10 @@
resolution timers are supposed to support at least the C<$which> value
of C<CLOCK_REALTIME>, see L</clock_gettime>.
-=item clock_nanosleep ( $which, $seconds, $flags = 0)
+=item clock_nanosleep ( $which, $nanoseconds, $flags = 0)
-Sleeps for the number of seconds (1e9ths of a second) specified.
-Returns the number of seconds actually slept. The $which is the
+Sleeps for the number of nanoseconds (1e9ths of a second) specified.
+Returns the number of nanoseconds actually slept. The $which is the
"clock id", as with clock_gettime() and clock_getres(). The flags
default to zero but C<TIMER_ABSTIME> can specified (must be exported
explicitly) which means that C<$nanoseconds> is not a time interval
@@ -357,6 +378,44 @@
compatibility limitations the returned value may wrap around at about
2147 seconds or at about 36 minutes.
+=item stat
+
+=item stat FH
+
+=item stat EXPR
+
+As L<perlfunc/stat> but with the access/modify/change file timestamps
+in subsecond resolution, if the operating system and the filesystem
+both support such timestamps. To override the standard stat():
+
+ use Time::HiRes qw(stat);
+
+Test for the value of &Time::HiRes::d_hires_stat to find out whether
+the operating system supports subsecond file timestamps: a value
+larger than zero means yes. There are unfortunately no easy
+ways to find out whether the filesystem supports such timestamps.
+UNIX filesystems often do; NTFS does; FAT doesn't (FAT timestamp
+granularity is B<two> seconds).
+
+A zero return value of &Time::HiRes::d_hires_stat means that
+Time::HiRes::stat is a no-op passthrough for CORE::stat(),
+and therefore the timestamps will stay integers. The same
+thing will happen if the filesystem does not do subsecond timestamps,
+even if the &Time::HiRes::d_hires_stat is non-zero.
+
+In any case do not expect nanosecond resolution, or even a microsecond
+resolution. Also note that the modify/access timestamps might have
+different resolutions, and that they need not be synchronized, e.g.
+if the operations are
+
+ write
+ stat # t1
+ read
+ stat # t2
+
+the access time stamp from t2 need not be greater-than the modify
+time stamp from t1: it may be equal or I<less>.
+
=back
=head1 EXAMPLES
@@ -368,6 +427,8 @@
# signal alarm in 2.5s & every .1s thereafter
ualarm(2_500_000, 100_000);
+ # cancel that ualarm
+ ualarm(0);
# get seconds and microseconds since the epoch
($s, $usec) = gettimeofday();
@@ -421,6 +482,9 @@
my $clock1 = clock();
my $clockd = $clock1 - $clock0;
+ use Time::HiRes qw( stat );
+ my ($atime, $mtime, $ctime) = (stat("istics"))[8, 9, 10];
+
=head1 C API
In addition to the perl API described above, a C API is available for
@@ -449,6 +513,12 @@
=head1 DIAGNOSTICS
+=head2 useconds or interval more than ...
+
+In ualarm() you tried to use number of microseconds or interval (also
+in microseconds) more than 1_000_000 and setitimer() is not available
+in your system to emulate that case.
+
=head2 negative time not invented yet
You tried to use a negative time argument.
@@ -478,8 +548,9 @@
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>.
+Your system documentation for C<clock>, C<clock_gettime>,
+C<clock_getres>, C<clock_nanosleep>, C<clock_settime>, C<getitimer>,
+C<gettimeofday>, C<setitimer>, C<sleep>, C<stat>, C<ualarm>.
=head1 AUTHORS
@@ -492,7 +563,7 @@
Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved.
-Copyright (c) 2002, 2003, 2004, 2005 Jarkko Hietaniemi. All rights reserved.
+Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007 Jarkko Hietaniemi. All
rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
==== //depot/maint-5.8/perl/ext/Time/HiRes/HiRes.xs#16 (text) ====
Index: perl/ext/Time/HiRes/HiRes.xs
--- perl/ext/Time/HiRes/HiRes.xs#15~26600~ 2006-01-03 05:23:00.000000000
-0800
+++ perl/ext/Time/HiRes/HiRes.xs 2007-02-14 07:29:27.000000000 -0800
@@ -2,7 +2,7 @@
*
* Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved.
*
- * Copyright (c) 2002,2003,2004,2005 Jarkko Hietaniemi. All rights reserved.
+ * Copyright (c) 2002,2003,2004,2005,2006,2007 Jarkko Hietaniemi. All rights
reserved.
*
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
@@ -37,6 +37,14 @@
}
#endif
+#define IV_1E6 1000000
+#define IV_1E7 10000000
+#define IV_1E9 1000000000
+
+#define NV_1E6 1000000.0
+#define NV_1E7 10000000.0
+#define NV_1E9 1000000000.0
+
#ifndef PerlProc_pause
# define PerlProc_pause() Pause()
#endif
@@ -58,13 +66,6 @@
# undef ITIMER_REALPROF
#endif
-/* 5.004 doesn't define PL_sv_undef */
-#ifndef ATLEASTFIVEOHOHFIVE
-# ifndef PL_sv_undef
-# define PL_sv_undef sv_undef
-# endif
-#endif
-
#if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC)
/* HP-UX has CLOCK_XXX values but as enums, not as defines.
@@ -115,6 +116,18 @@
#endif
#define EPOCH_BIAS Const64(116444736000000000)
+#ifdef Const64
+# ifdef __GNUC__
+# define IV_1E6LL 1000000LL /* Needed because of Const64() ##-appends LL (or
i64). */
+# define IV_1E7LL 10000000LL
+# define IV_1E9LL 1000000000LL
+# else
+# define IV_1E6i64 1000000i64
+# define IV_1E7i64 10000000i64
+# define IV_1E9i64 1000000000i64
+# endif
+#endif
+
/* NOTE: This does not compute the timezone info (doing so can be expensive,
* and appears to be unsupported even by glibc) */
@@ -154,8 +167,8 @@
QueryPerformanceCounter((LARGE_INTEGER*)&ticks);
ticks -= MY_CXT.base_ticks;
ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64
- + Const64(10000000) * (ticks / MY_CXT.tick_frequency)
- +(Const64(10000000) * (ticks % MY_CXT.tick_frequency)) /
MY_CXT.tick_frequency;
+ + Const64(IV_1E7) * (ticks / MY_CXT.tick_frequency)
+ +(Const64(IV_1E7) * (ticks % MY_CXT.tick_frequency)) /
MY_CXT.tick_frequency;
diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64;
if (diff < -MAX_PERF_COUNTER_SKEW || diff > MAX_PERF_COUNTER_SKEW) {
MY_CXT.base_ticks += ticks;
@@ -165,10 +178,10 @@
}
/* seconds since epoch */
- tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000));
+ tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(IV_1E7));
/* microseconds remaining */
- tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000));
+ tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(IV_1E6));
return 0;
}
@@ -383,8 +396,8 @@
hrt_nanosleep(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;
+ res.tv_sec = usec / IV_1E6;
+ res.tv_nsec = ( usec - res.tv_sec * IV_1E6 ) * 1000;
nanosleep(&res, NULL);
}
@@ -448,22 +461,31 @@
#endif /* #if !defined(HAS_USLEEP) && defined(HAS_POLL) */
-#if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
-#define HAS_UALARM
-#define ualarm hrt_ualarm /* could conflict with ncurses for static build */
-
+#if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
int
-hrt_ualarm(int usec, int interval)
+hrt_ualarm_itimer(int usec, int interval)
{
struct itimerval itv;
- itv.it_value.tv_sec = usec / 1000000;
- itv.it_value.tv_usec = usec % 1000000;
- itv.it_interval.tv_sec = interval / 1000000;
- itv.it_interval.tv_usec = interval % 1000000;
+ itv.it_value.tv_sec = usec / IV_1E6;
+ itv.it_value.tv_usec = usec % IV_1E6;
+ itv.it_interval.tv_sec = interval / IV_1E6;
+ itv.it_interval.tv_usec = interval % IV_1E6;
return setitimer(ITIMER_REAL, &itv, 0);
}
+#ifdef HAS_UALARM
+int
+hrt_ualarm(int usec, int interval) /* for binary compat before 1.91 */
+{
+ return hrt_ualarm_itimer(usec, interval);
+}
+#endif /* #ifdef HAS_UALARM */
#endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */
+#if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
+#define HAS_UALARM
+#define ualarm hrt_ualarm_itimer /* could conflict with ncurses for static
build */
+#endif
+
#if !defined(HAS_UALARM) && defined(VMS)
#define HAS_UALARM
#define ualarm vms_ualarm
@@ -683,11 +705,47 @@
struct timeval Tp;
int status;
status = gettimeofday (&Tp, NULL);
- return status == 0 ? Tp.tv_sec + (Tp.tv_usec / 1000000.) : -1.0;
+ return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0;
}
#endif /* #ifdef HAS_GETTIMEOFDAY */
+static void
+hrstatns(UV atime, UV mtime, UV ctime, UV *atime_nsec, UV *mtime_nsec, UV
*ctime_nsec)
+{
+ dTHXR;
+ *atime_nsec = 0;
+ *mtime_nsec = 0;
+ *ctime_nsec = 0;
+#ifdef TIME_HIRES_STAT
+#if TIME_HIRES_STAT == 1
+ *atime_nsec = PL_statcache.st_atimespec.tv_nsec;
+ *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec;
+ *ctime_nsec = PL_statcache.st_ctimespec.tv_nsec;
+#endif
+#if TIME_HIRES_STAT == 2
+ *atime_nsec = PL_statcache.st_atimensec;
+ *mtime_nsec = PL_statcache.st_mtimensec;
+ *ctime_nsec = PL_statcache.st_ctimensec;
+#endif
+#if TIME_HIRES_STAT == 3
+ *atime_nsec = PL_statcache.st_atime_n;
+ *mtime_nsec = PL_statcache.st_mtime_n;
+ *ctime_nsec = PL_statcache.st_ctime_n;
+#endif
+#if TIME_HIRES_STAT == 4
+ *atime_nsec = PL_statcache.st_atim.tv_nsec;
+ *mtime_nsec = PL_statcache.st_mtim.tv_nsec;
+ *ctime_nsec = PL_statcache.st_ctim.tv_nsec;
+#endif
+#if TIME_HIRES_STAT == 5
+ *atime_nsec = PL_statcache.st_uatime * 1000;
+ *mtime_nsec = PL_statcache.st_umtime * 1000;
+ *ctime_nsec = PL_statcache.st_uctime * 1000;
+#endif
+#endif
+}
+
#include "const-c.inc"
MODULE = Time::HiRes PACKAGE = Time::HiRes
@@ -700,12 +758,12 @@
MY_CXT_INIT;
#endif
#ifdef ATLEASTFIVEOHOHFIVE
-#ifdef HAS_GETTIMEOFDAY
+# ifdef HAS_GETTIMEOFDAY
{
hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0);
hv_store(PL_modglobal, "Time::U2time", 12, newSViv(PTR2IV(myU2time)), 0);
}
-#endif
+# endif
#endif
}
@@ -759,31 +817,24 @@
nanosleep(nsec)
NV nsec
PREINIT:
- int status = -1;
- struct timeval Ta, Tb;
+ struct timespec sleepfor, unslept;
CODE:
- gettimeofday(&Ta, NULL);
- if (items > 0) {
- struct timespec ts1;
- if (nsec > 1E9) {
- IV sec = (IV) (nsec / 1E9);
- if (sec) {
- sleep(sec);
- nsec -= 1E9 * sec;
- }
- } else if (nsec < 0.0)
- croak("Time::HiRes::nanosleep(%"NVgf"): negative time not
invented yet", nsec);
- ts1.tv_sec = (IV) (nsec / 1E9);
- ts1.tv_nsec = (IV) nsec - ts1.tv_sec * 1E9;
- status = nanosleep(&ts1, NULL);
+ if (nsec < 0.0)
+ croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented
yet", nsec);
+ sleepfor.tv_sec = nsec / 1e9;
+ sleepfor.tv_nsec = nsec - ((NV)sleepfor.tv_sec) * 1e9;
+ if (!nanosleep(&sleepfor, &unslept)) {
+ RETVAL = nsec;
} else {
- PerlProc_pause();
- status = 0;
+ sleepfor.tv_sec -= unslept.tv_sec;
+ sleepfor.tv_nsec -= unslept.tv_nsec;
+ if (sleepfor.tv_nsec < 0) {
+ sleepfor.tv_sec--;
+ sleepfor.tv_nsec += 1000000000;
+ }
+ RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec);
}
- gettimeofday(&Tb, NULL);
- RETVAL = status == 0 ?
1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1;
-
- OUTPUT:
+ OUTPUT:
RETVAL
#else /* #if defined(TIME_HIRES_NANOSLEEP) */
@@ -854,7 +905,14 @@
CODE:
if (useconds < 0 || interval < 0)
croak("Time::HiRes::ualarm(%d, %d): negative time not invented
yet", useconds, interval);
- RETVAL = ualarm(useconds, interval);
+ if (useconds >= IV_1E6 || interval >= IV_1E6)
+#if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
+ RETVAL = hrt_ualarm_itimer(useconds, interval);
+#else
+ croak("Time::HiRes::ualarm(%d, %d): useconds or interval equal
or more than %"IVdf, useconds, interval, IV_1E6);
+#endif
+ else
+ RETVAL = ualarm(useconds, interval);
OUTPUT:
RETVAL
@@ -866,8 +924,8 @@
CODE:
if (seconds < 0.0 || interval < 0.0)
croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not
invented yet", seconds, interval);
- RETVAL = (NV)ualarm(seconds * 1000000,
- interval * 1000000) / 1E6;
+ RETVAL = (NV)ualarm((IV)(seconds * IV_1E6),
+ (IV)(interval * IV_1E6)) / NV_1E6;
OUTPUT:
RETVAL
@@ -912,7 +970,7 @@
PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
} else {
EXTEND(sp, 1);
- PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec /
1000000.0))));
+ PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6))));
}
}
@@ -926,7 +984,7 @@
status = gettimeofday (&Tp, &Tz);
if (status == 0) {
Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */
- RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.0);
+ RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6);
} else {
RETVAL = -1.0;
}
@@ -948,7 +1006,7 @@
PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
} else {
EXTEND(sp, 1);
- PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec /
1000000.0))));
+ PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6))));
}
}
@@ -960,7 +1018,7 @@
int status;
status = gettimeofday (&Tp, NULL);
if (status == 0) {
- RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.);
+ RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6);
} else {
RETVAL = -1.0;
}
@@ -985,12 +1043,12 @@
PPCODE:
if (seconds < 0.0 || interval < 0.0)
croak("Time::HiRes::setitimer(%"IVdf", %"NVgf", %"NVgf"): negative
time not invented yet", (IV)which, seconds, interval);
- newit.it_value.tv_sec = seconds;
+ newit.it_value.tv_sec = (IV)seconds;
newit.it_value.tv_usec =
- (seconds - (NV)newit.it_value.tv_sec) * 1000000.0;
- newit.it_interval.tv_sec = interval;
+ (IV)((seconds - (NV)newit.it_value.tv_sec) * NV_1E6);
+ newit.it_interval.tv_sec = (IV)interval;
newit.it_interval.tv_usec =
- (interval - (NV)newit.it_interval.tv_sec) * 1000000.0;
+ (IV)((interval - (NV)newit.it_interval.tv_sec) * NV_1E6);
if (setitimer(which, &newit, &oldit) == 0) {
EXTEND(sp, 1);
PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
@@ -1080,27 +1138,28 @@
#if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)
NV
-clock_nanosleep(clock_id = CLOCK_REALTIME, sec = 0.0, flags = 0)
+clock_nanosleep(clock_id, nsec, flags = 0)
int clock_id
- NV sec
+ NV nsec
int flags
PREINIT:
- int status = -1;
- struct timespec ts;
- struct timeval Ta, Tb;
+ struct timespec sleepfor, unslept;
CODE:
- gettimeofday(&Ta, NULL);
- if (items > 1) {
- ts.tv_sec = (IV) sec;
- ts.tv_nsec = (sec - (NV) ts.tv_sec) * (NV) 1E9;
- status = clock_nanosleep(clock_id, flags, &ts, NULL);
+ if (nsec < 0.0)
+ croak("Time::HiRes::clock_nanosleep(..., %"NVgf"): negative time
not invented yet", nsec);
+ sleepfor.tv_sec = nsec / 1e9;
+ sleepfor.tv_nsec = nsec - ((NV)sleepfor.tv_sec) * 1e9;
+ if (!clock_nanosleep(clock_id, flags, &sleepfor, &unslept)) {
+ RETVAL = nsec;
} else {
- PerlProc_pause();
- status = 0;
+ sleepfor.tv_sec -= unslept.tv_sec;
+ sleepfor.tv_nsec -= unslept.tv_nsec;
+ if (sleepfor.tv_nsec < 0) {
+ sleepfor.tv_sec--;
+ sleepfor.tv_nsec += 1000000000;
+ }
+ RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec);
}
- gettimeofday(&Tb, NULL);
- RETVAL = status == 0 ?
1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1;
-
OUTPUT:
RETVAL
@@ -1137,3 +1196,35 @@
#endif /* #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
+void
+stat(...)
+PROTOTYPE: ;$
+ PPCODE:
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV)));
+ PUTBACK;
+ ENTER;
+ PL_laststatval = -1;
+ (void)*(PL_ppaddr[OP_STAT])(aTHXR);
+ SPAGAIN;
+ LEAVE;
+ if (PL_laststatval == 0) {
+ /* We assume that pp_stat() left us with 13 valid stack items,
+ * and that the timestamps are at offsets 8, 9, and 10. */
+ UV atime = SvUV(ST( 8));
+ UV mtime = SvUV(ST( 9));
+ UV ctime = SvUV(ST(10));
+ UV atime_nsec;
+ UV mtime_nsec;
+ UV ctime_nsec;
+ hrstatns(atime, mtime, ctime,
+ &atime_nsec, &mtime_nsec, &ctime_nsec);
+ if (atime_nsec)
+ ST( 8) = sv_2mortal(newSVnv(atime + 1e-9 * (NV) atime_nsec));
+ if (mtime_nsec)
+ ST( 9) = sv_2mortal(newSVnv(mtime + 1e-9 * (NV) mtime_nsec));
+ if (ctime_nsec)
+ ST(10) = sv_2mortal(newSVnv(ctime + 1e-9 * (NV) ctime_nsec));
+ XSRETURN(13);
+ }
+ XSRETURN(0);
==== //depot/maint-5.8/perl/ext/Time/HiRes/Makefile.PL#30 (text) ====
Index: perl/ext/Time/HiRes/Makefile.PL
--- perl/ext/Time/HiRes/Makefile.PL#29~26600~ 2006-01-03 05:23:00.000000000
-0800
+++ perl/ext/Time/HiRes/Makefile.PL 2007-02-14 07:29:27.000000000 -0800
@@ -102,6 +102,16 @@
$COREincdir = File::Spec->catdir($Config{'archlibexp'}, 'CORE');
}
+ if ($ENV{PERL_CORE}) {
+ unless (-f File::Spec->catfile($COREincdir, "EXTERN.h")) {
+ die <<__EOD__;
+Your environment variable PERL_CORE is '$ENV{PERL_CORE}' but there
+is no EXTERN.h in $COREincdir.
+Cannot continue, aborting.
+__EOD__
+ }
+ }
+
my $ccflags = $Config{'ccflags'} . ' ' . "-I$COREincdir";
if ($^O eq 'VMS') {
@@ -169,30 +179,32 @@
return $ok;
}
-sub has_gettimeofday {
- # confusing but true (if condition true ==> -DHAS_GETTIMEOFDAY already)
- return 0 if $Config{d_gettimeod};
- return 1 if try_compile_and_link(<<EOM);
+my $TIME_HEADERS = <<EOH;
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef I_SYS_TYPES
# include <sys/types.h>
#endif
-
#ifdef I_SYS_TIME
# include <sys/time.h>
#endif
-
#ifdef I_SYS_SELECT
# include <sys/select.h> /* struct timeval might be hidden in here */
#endif
+EOH
+
+sub has_gettimeofday {
+ # confusing but true (if condition true ==> -DHAS_GETTIMEOFDAY already)
+ return 0 if $Config{d_gettimeod};
+ return 1 if try_compile_and_link(<<EOM);
+$TIME_HEADERS
static int foo()
{
struct timeval tv;
gettimeofday(&tv, 0);
}
-int main _((int argc, char** argv, char** env))
+int main(int argc, char** argv)
{
foo();
}
@@ -221,7 +233,7 @@
# include <sys/time.h>
#endif
-int main _((int argc, char** argv, char** env))
+int main(int argc, char** argv)
{
$x;
}
@@ -241,7 +253,7 @@
/* int nanosleep(const struct timespec *rqtp, struct timespec *rmtp); */
-int main() {
+int main(int argc, char** argv) {
struct timespec ts1, ts2;
int ret;
ts1.tv_sec = 0;
@@ -264,7 +276,7 @@
#include "XSUB.h"
#include <$inc>
-int main _((int argc, char** argv, char** env))
+int main(int argc, char** argv)
{
return 0;
}
@@ -281,7 +293,7 @@
#include "perl.h"
#include "XSUB.h"
#include <$SYSCALL_H>
-int main _((int argc, char** argv, char** env))
+int main(int argc, char** argv)
{
struct timespec ts;
/* Many Linuxes get ENOSYS even though the syscall exists. */
@@ -299,7 +311,7 @@
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-int main _((int argc, char** argv, char** env))
+int main(int argc, char** argv)
{
struct timespec ts;
int ret = clock_$xxx(CLOCK_REALTIME, &ts); /* Many Linuxes get ENOSYS. */
@@ -315,7 +327,7 @@
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-int main _((int argc, char** argv, char** env))
+int main(int argc, char** argv)
{
clock_t tictoc;
clock_t ret = clock();
@@ -330,11 +342,12 @@
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-int main _((int argc, char** argv, char** env))
+#include <time.h>
+int main(int argc, char** argv)
{
int ret;
- struct timerspec ts1;
- struct timerspec ts2;
+ struct timespec ts1;
+ struct timespec ts2;
ts1.tv_sec = 0;
ts1.tv_nsec = 750000000;;
ret = clock_nanosleep(CLOCK_MONOTONIC, 0, &ts1, &ts2);
@@ -343,6 +356,14 @@
EOM
}
+sub DEFINE {
+ my ($def, $val) = @_;
+ my $define = defined $val ? "$def=$val" : $def ;
+ unless ($DEFINE =~ /(?:^| )-D\Q$define\E(?: |$)/) {
+ $DEFINE .= " -D$define";
+ }
+}
+
sub init {
my $hints = File::Spec->catfile("hints", "$^O.pl");
if (-f $hints) {
@@ -589,13 +610,122 @@
print "NOT found.\n";
}
+ print "Looking for stat() subsecond timestamps...\n";
+
+ print "Trying struct stat st_atimespec.tv_nsec...";
+ my $has_stat_st_xtimespec;
+ if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main(int argc, char** argv) {
+ struct stat st;
+ st.st_atimespec.tv_nsec = 0;
+}
+EOM
+ $has_stat_st_xtimespec++;
+ DEFINE('TIME_HIRES_STAT', 1);
+ }
+
+ if ($has_stat_st_xtimespec) {
+ print "found.\n";
+ } else {
+ print "NOT found.\n";
+ }
+
+ print "Trying struct stat st_atimensec...";
+ my $has_stat_st_xtimensec;
+ if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main(int argc, char** argv) {
+ struct stat st;
+ st.st_atimensec = 0;
+}
+EOM
+ $has_stat_st_xtimensec++;
+ DEFINE('TIME_HIRES_STAT', 2);
+ }
+
+ if ($has_stat_st_xtimensec) {
+ print "found.\n";
+ } else {
+ print "NOT found.\n";
+ }
+
+ print "Trying struct stat st_atime_n...";
+ my $has_stat_st_xtime_n;
+ if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main(int argc, char** argv) {
+ struct stat st;
+ st.st_atime_n = 0;
+}
+EOM
+ $has_stat_st_xtime_n++;
+ DEFINE('TIME_HIRES_STAT', 3);
+ }
+
+ if ($has_stat_st_xtime_n) {
+ print "found.\n";
+ } else {
+ print "NOT found.\n";
+ }
+
+ print "Trying struct stat st_atim.tv_nsec...";
+ my $has_stat_st_xtim;
+ if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main(int argc, char** argv) {
+ struct stat st;
+ st.st_atim.tv_nsec = 0;
+}
+EOM
+ $has_stat_st_xtim++;
+ DEFINE('TIME_HIRES_STAT', 4);
+ }
+
+ if ($has_stat_st_xtim) {
+ print "found.\n";
+ } else {
+ print "NOT found.\n";
+ }
+
+ print "Trying struct stat st_uatime...";
+ my $has_stat_st_uxtime;
+ if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+int main(int argc, char** argv) {
+ struct stat st;
+ st.st_uatime = 0;
+}
+EOM
+ $has_stat_st_uxtime++;
+ DEFINE('TIME_HIRES_STAT', 5);
+ }
+
+ if ($has_stat_st_uxtime) {
+ print "found.\n";
+ } else {
+ print "NOT found.\n";
+ }
+
+ if ($DEFINE =~ /-DTIME_HIRES_STAT=\d+/) {
+ print "You seem to have stat() subsecond timestamps.\n";
+ print "(Your struct stat has them, but the filesystems must help.)\n";
+ } else {
+ print "You do not seem to have stat subsecond timestamps.\n";
+ }
+
my $has_w32api_windows_h;
if ($^O eq 'cygwin') {
print "Looking for <w32api/windows.h>... ";
if (has_include('w32api/windows.h')) {
$has_w32api_windows_h++;
- $DEFINE .= ' -DHAS_W32API_WINDOWS_H';
+ DEFINE('HAS_W32API_WINDOWS_H');
}
if ($has_w32api_windows_h) {
print "found.\n";
@@ -621,7 +751,7 @@
'AUTHOR' => 'Jarkko Hietaniemi <[EMAIL PROTECTED]>',
'ABSTRACT_FROM' => 'HiRes.pm',
);
- $DEFINE .= " -DATLEASTFIVEOHOHFIVE";
+ DEFINE('ATLEASTFIVEOHOHFIVE');
}
push (@makefileopts,
@@ -652,22 +782,28 @@
sub doConstants {
if (eval {require ExtUtils::Constant; 1}) {
- my @names = (qw(CLOCK_HIGHRES CLOCK_MONOTONIC
- CLOCK_PROCESS_CPUTIME_ID
- CLOCK_REALTIME
- CLOCK_SOFTTIME
- CLOCK_THREAD_CPUTIME_ID
- CLOCK_TIMEOFDAY
- CLOCKS_PER_SEC
- ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
- ITIMER_REALPROF
- TIMER_ABSTIME));
+ my @names = qw(CLOCK_HIGHRES CLOCK_MONOTONIC
+ CLOCK_PROCESS_CPUTIME_ID
+ CLOCK_REALTIME
+ CLOCK_SOFTTIME
+ CLOCK_THREAD_CPUTIME_ID
+ CLOCK_TIMEOFDAY
+ CLOCKS_PER_SEC
+ ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
+ ITIMER_REALPROF
+ TIMER_ABSTIME);
foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
d_nanosleep d_clock_gettime d_clock_getres
- d_clock d_clock_nanosleep)) {
+ d_clock d_clock_nanosleep d_hires_stat)) {
my $macro = $_;
if ($macro =~
/^(d_nanosleep|d_clock_gettime|d_clock_getres|d_clock|d_clock_nanosleep)$/) {
$macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
+ } elsif ($macro =~ /^(d_hires_stat)$/) {
+ my $d_hires_stat = 0;
+ $d_hires_stat = $1 if ($DEFINE =~ /-DTIME_HIRES_STAT=(\d+)/);
+ push @names, {name => $_, macro => "TIME_HIRES_STAT", value =>
$d_hires_stat,
+ default => ["IV", "0"]};
+ next;
} else {
$macro =~ s/^d_(.+)/HAS_\U$1/;
}
@@ -699,7 +835,7 @@
}
if ($^O =~ /Win32/i) {
- $DEFINE = '-DSELECT_IS_BROKEN';
+ DEFINE('SELECT_IS_BROKEN');
$LIBS = [];
print "System is $^O, skipping full configure...\n";
} else {
@@ -720,6 +856,7 @@
Makefile:91: *** missing separator
then set the environment variable LC_ALL to "C" and retry
from scratch (re-run perl "Makefile.PL").
+(And consider upgrading your Perl.)
EOM
}
}
==== //depot/maint-5.8/perl/ext/Time/HiRes/fallback/const-c.inc#4 (text) ====
Index: perl/ext/Time/HiRes/fallback/const-c.inc
--- perl/ext/Time/HiRes/fallback/const-c.inc#3~26600~ 2006-01-03
05:23:00.000000000 -0800
+++ perl/ext/Time/HiRes/fallback/const-c.inc 2007-02-14 07:29:27.000000000
-0800
@@ -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
@@ -250,6 +249,7 @@
{name=>"d_clock_nanosleep", type=>"IV",
macro=>"TIME_HIRES_CLOCK_NANOSLEEP", 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_hires_stat", type=>"IV", macro=>"TIME_HIRES_STAT",
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"]},
@@ -310,6 +310,17 @@
case 11:
return constant_11 (aTHX_ name, iv_return);
break;
+ case 12:
+ if (memEQ(name, "d_hires_stat", 12)) {
+#ifdef TIME_HIRES_STAT
+ *iv_return = 1;
+ return PERL_constant_ISIV;
+#else
+ *iv_return = 0;
+ return PERL_constant_ISIV;
+#endif
+ }
+ break;
case 13:
/* Names all of length 13. */
/* CLOCK_HIGHRES TIMER_ABSTIME */
==== //depot/maint-5.8/perl/ext/Time/HiRes/hints/aix.pl#1 (text) ====
Index: perl/ext/Time/HiRes/hints/aix.pl
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/ext/Time/HiRes/hints/aix.pl 2007-02-14 07:29:27.000000000 -0800
@@ -0,0 +1,18 @@
+# Many AIX installations seem not to have the right PATH
+# for the C compiler. Steal the logic from Perl's hints/aix.sh.
+use Config;
+unless ($Config{gccversion}) {
+ my $cc = $Config{cc};
+ if (! -x $cc && -x "/usr/vac/bin/$cc") {
+ unless (":$ENV{PATH}:" =~ m{:/usr/vac/bin:}) {
+ die <<__EOE__;
+***
+*** You either implicitly or explicitly specified an IBM C compiler,
+*** but you do not seem to have one in /usr/bin, but you seem to have
+*** the VAC installed in /usr/vac, but you do not have the /usr/vac/bin
+*** in your PATH. I suggest adding that and retrying Makefile.PL.
+***
+__EOE__
+ }
+ }
+}
==== //depot/maint-5.8/perl/ext/Time/HiRes/hints/linux.pl#1 (text) ====
Index: perl/ext/Time/HiRes/hints/linux.pl
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/ext/Time/HiRes/hints/linux.pl 2007-02-14 07:29:27.000000000 -0800
@@ -0,0 +1,2 @@
+# needs to explicitly link against librt to pull in clock_nanosleep
+$self->{LIBS} = ['-lrt'];
==== //depot/maint-5.8/perl/ext/Time/HiRes/t/HiRes.t#12 (text) ====
Index: perl/ext/Time/HiRes/t/HiRes.t
--- perl/ext/Time/HiRes/t/HiRes.t#11~26600~ 2006-01-03 05:23:00.000000000
-0800
+++ perl/ext/Time/HiRes/t/HiRes.t 2007-02-14 07:29:27.000000000 -0800
@@ -12,10 +12,11 @@
}
}
-BEGIN { $| = 1; print "1..33\n"; }
+BEGIN { $| = 1; print "1..38\n"; }
END { print "not ok 1\n" unless $loaded }
+use Time::HiRes 1.9704; # Remember to bump this once in a while.
use Time::HiRes qw(tv_interval);
$loaded = 1;
@@ -32,6 +33,7 @@
my $have_clock_getres = &Time::HiRes::d_clock_getres;
my $have_clock_nanosleep = &Time::HiRes::d_clock_nanosleep;
my $have_clock = &Time::HiRes::d_clock;
+my $have_hires_stat = &Time::HiRes::d_hires_stat;
sub has_symbol {
my $symbol = shift;
@@ -49,6 +51,7 @@
printf "# have_clock_getres = %d\n", $have_clock_getres;
printf "# have_clock_nanosleep = %d\n", $have_clock_nanosleep;
printf "# have_clock = %d\n", $have_clock;
+printf "# have_hires_stat = %d\n", $have_hires_stat;
import Time::HiRes 'gettimeofday' if $have_gettimeofday;
import Time::HiRes 'usleep' if $have_usleep;
@@ -65,7 +68,7 @@
my $have_alarm = $Config{d_alarm};
my $have_fork = $Config{d_fork};
-my $waitfor = 60; # 10-20 seconds is normal (load affects this).
+my $waitfor = 90; # 30-45 seconds is normal (load affects this).
my $timer_pid;
my $TheEnd;
@@ -74,11 +77,12 @@
$timer_pid = fork();
if (defined $timer_pid) {
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 the main process...\n";
- kill('TERM', getppid());
+ print "# Terminating main process $ppid...\n";
+ kill('TERM', $ppid);
print "# This is the timer process $$, over and out.\n";
exit(0);
} else {
@@ -224,9 +228,10 @@
$n++;
}
# $s should be, at worst, equal to $n
- # (time() may be rounding down, up, or closest)
- ok 14, abs($s) / $n <= 1.0, "Time::HiRes::time() not close to time()";
- print "# s = $s, n = $n, s/n = ", $s/$n, "\n";
+ # (time() may be rounding down, up, or closest),
+ # but allow 10% of slop.
+ ok 14, abs($s) / $n <= 1.10, "Time::HiRes::time() not close to time()";
+ print "# s = $s, n = $n, s/n = ", abs($s)/$n, "\n";
}
my $has_ualarm = $Config{d_ualarm};
@@ -436,38 +441,40 @@
skip 28;
}
+# Find the loop size N (a for() loop 0..N-1)
+# that will take more than T seconds.
+
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.
+ print "# Finding delay loop...\n";
my $T = 0.01;
use Time::HiRes qw(time);
- my $N = 1024;
+ my $DelayN = 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);
- }
+ N: {
+ do {
+ my $t0 = time();
+ for ($i = 0; $i < $DelayN; $i++) { }
+ my $t1 = time();
+ my $dt = $t1 - $t0;
+ print "# N = $DelayN, t1 = $t1, t0 = $t0, dt = $dt\n";
+ last N if $dt > $T;
+ $DelayN *= 2;
+ } while (1);
+ }
- # The time-burner which takes at least T seconds.
- my $F = sub {
+ # The time-burner which takes at least T (default 1) seconds.
+ my $Delay = sub {
my $c = @_ ? shift : 1;
- my $n = $c * $N;
+ my $n = $c * $DelayN;
my $i;
for ($i = 0; $i < $n; $i++) { }
};
- # Then we will setup a periodic timer (the two-argument alarm() of
+ # Next 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)
@@ -486,13 +493,13 @@
$a++;
print "# Alarm $a - ", time(), "\n";
alarm(0) if $a >= $A; # Disarm the alarm.
- $F->(2); # Try burning CPU at least for 2T seconds.
+ $Delay->(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.
+ $Delay->(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 {
@@ -553,7 +560,7 @@
if ($have_clock_nanosleep &&
has_symbol('CLOCK_REALTIME')) {
- my $s = 1.5;
+ my $s = 1.5e9;
my $t = clock_nanosleep(&CLOCK_REALTIME, $s);
my $r = abs(1 - $t / $s);
if ($r < 2 * $limit) {
@@ -575,7 +582,7 @@
print "# clock = @clock\n";
}
if ($clock[0] >= 0 &&
- $clock[1] > $clock[0] &&
+ $clock[1] > $clock[0] &&
$clock[2] > $clock[1] &&
$clock[3] > $clock[2]) {
print "ok 33\n";
@@ -583,15 +590,104 @@
print "not ok 33\n";
}
} else {
- print "# No clock\n";
skip 33;
}
+if ($have_ualarm) {
+ # 1_100_000 sligthly over 1_000_000,
+ # 2_200_000 slightly over 2**31/1000,
+ # 4_300_000 slightly over 2**32/1000.
+ for my $t ([34, 100_000],
+ [35, 1_100_000],
+ [36, 2_200_000],
+ [37, 4_300_000]) {
+ my ($i, $n) = @$t;
+ my $alarmed = 0;
+ local $SIG{ ALRM } = sub { $alarmed++ };
+ my $t0 = Time::HiRes::time();
+ print "# t0 = $t0\n";
+ print "# ualarm($n)\n";
+ ualarm($n); 1 while $alarmed == 0;
+ my $t1 = Time::HiRes::time();
+ print "# t1 = $t1\n";
+ my $dt = $t1 - $t0;
+ print "# dt = $dt\n";
+ my $r = $dt / ($n/1e6);
+ ok $i,
+ ($n < 1_000_000 || # Too much noise.
+ $r >= 0.9 && $r <= 1.5), "ualarm($n) close enough";
+ }
+} else {
+ print "# No ualarm\n";
+ skip 34..37;
+}
+
+if ($^O =~ /^(cygwin|MSWin)/) {
+ print "# $^O: timestamps may not be good enough\n";
+ skip 38;
+} elsif (&Time::HiRes::d_hires_stat) {
+ my @stat;
+ my @atime;
+ my @mtime;
+ for (1..5) {
+ Time::HiRes::sleep(rand(0.1) + 0.1);
+ open(X, ">$$");
+ print X $$;
+ close(X);
+ @stat = Time::HiRes::stat($$);
+ push @mtime, $stat[9];
+ Time::HiRes::sleep(rand(0.1) + 0.1);
+ open(X, "<$$");
+ <X>;
+ close(X);
+ @stat = Time::HiRes::stat($$);
+ push @atime, $stat[8];
+ }
+ 1 while unlink $$;
+ print "# mtime = @mtime\n";
+ print "# atime = @atime\n";
+ my $ai = 0;
+ my $mi = 0;
+ my $ss = 0;
+ for (my $i = 1; $i < @atime; $i++) {
+ if ($atime[$i] >= $atime[$i-1]) {
+ $ai++;
+ }
+ if ($atime[$i] > int($atime[$i])) {
+ $ss++;
+ }
+ }
+ for (my $i = 1; $i < @mtime; $i++) {
+ if ($mtime[$i] >= $mtime[$i-1]) {
+ $mi++;
+ }
+ if ($mtime[$i] > int($mtime[$i])) {
+ $ss++;
+ }
+ }
+ print "# ai = $ai, mi = $mi, ss = $ss\n";
+ # Need at least 75% of monotonical increase and
+ # 20% of subsecond results. Yes, this is guessing.
+ if ($ss == 0) {
+ print "# No subsecond timestamps detected\n";
+ skip 38;
+ } elsif ($mi/(@mtime-1) >= 0.75 && $ai/(@atime-1) >= 0.75 &&
+ $ss/(@[EMAIL PROTECTED]) >= 0.2) {
+ print "ok 38\n";
+ } else {
+ print "not ok 38\n";
+ }
+} else {
+ print "# No effectual d_hires_stat\n";
+ skip 38;
+}
+
END {
- if (defined $timer_pid) {
+ 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;
- kill('TERM', $timer_pid); # We are done, the timer can go.
+ my $kill = kill('TERM', $timer_pid); # We are done, the timer can go.
+ printf "# kill TERM $timer_pid = %d\n", $kill;
unlink("ktrace.out"); # Used in BSD system call tracing.
print "# All done.\n";
}
End of Patch.
