687 lines
24 KiB
Diff
687 lines
24 KiB
Diff
|
Time-HiRes-1.9719
|
||
|
|
|
||
|
|
diff -urN perl-5.10.0.orig/ext/Time/HiRes/Changes perl-5.10.0/ext/Time/HiRes/Changes
|
||
|
|
--- perl-5.10.0.orig/ext/Time/HiRes/Changes 2007-12-18 11:47:07.000000000 +0100
|
||
|
|
+++ perl-5.10.0/ext/Time/HiRes/Changes 2009-03-10 17:48:02.000000000 +0100
|
||
|
|
@@ -1,5 +1,66 @@
|
||
|
|
Revision history for the Perl extension Time::HiRes.
|
||
|
|
|
||
|
|
+1.9719 [2009-01-04]
|
||
|
|
+ - As with QNX, Haiku has the API of interval timers but not
|
||
|
|
+ the implementation (bleadperl change #34630), hence skip
|
||
|
|
+ the tests, via David Mitchell.
|
||
|
|
+
|
||
|
|
+1.9718 [2008-12-31]
|
||
|
|
+ - .xs code cleanup from Albert Dvornik
|
||
|
|
+ - in the #39 and #40 do not do us I did, mixing alarm() and
|
||
|
|
+ sleep(). Now instead spin until enough time has passed.
|
||
|
|
+
|
||
|
|
+1.9717 [2008-12-30]
|
||
|
|
+ - Skip the tests added in 1.9716 (#39, #40) if there's no subsecond
|
||
|
|
+ alarm capability, like with the older subsecond alarm tests
|
||
|
|
+
|
||
|
|
+1.9716 [2008-12-26]
|
||
|
|
+ - Change documentation to agree with reality: there are
|
||
|
|
+ no interval timers in Win32.
|
||
|
|
+ - Address [rt.cpan.org #35899] (problem in subsecond sleeps),
|
||
|
|
+ add two tests to guard against this problem
|
||
|
|
+ - Address [rt.cpan.org #36600] 'Division by zero' failure in test suite
|
||
|
|
+ - Address [rt.cpan.org #37340] [PATCH] Address timer process in test
|
||
|
|
+ - Address [rt.cpan.org#40311 ] bad implementation of hrt_usleep
|
||
|
|
+ with TIME_HIRES_NANOSLEEP
|
||
|
|
+
|
||
|
|
+1.9715 [2008-04-08]
|
||
|
|
+ - Silly me: Makefile.PL does need to accept arguments other than mine.
|
||
|
|
+ Some testing frameworks obviously do this.
|
||
|
|
+ - Add retrying for tests 34..37, which are the most commonly
|
||
|
|
+ failing tests. If this helps, consider extending the retry
|
||
|
|
+ framework to all the tests. [Inspired by Slaven Rezic,
|
||
|
|
+ [rt.cpan.org #34711] Occasional failures of test 35 or 36 (FreeBSD)]
|
||
|
|
+
|
||
|
|
+1.9714 [2008-04-07]
|
||
|
|
+ - Under Perl 5.6.* NVgf needs to be "g", reported by Zefram,
|
||
|
|
+ it seems that ppport.h 3.13 gets this wrong.
|
||
|
|
+ - remove the check in Makefile.PL for 5.7.2, shouldn't be
|
||
|
|
+ (a) necessary (b) relevant
|
||
|
|
+ - add logic to Makefile.PL to skip configure/write Makefile
|
||
|
|
+ step if the "xdefine" file already exists, indicating that
|
||
|
|
+ the configure step has already been done, one can still
|
||
|
|
+ force (re)configure by "perl Makefile.PL configure",
|
||
|
|
+ or of course by "make clean && perl Makefile.PL".
|
||
|
|
+
|
||
|
|
+1.9713 [2008-04-04]
|
||
|
|
+ - for alarm() and ualarm() [Perl] prefer setitimer() [C]
|
||
|
|
+ instead of ualarm() [C] since ualarm() [C] cannot portably
|
||
|
|
+ (and standards-compliantly) be used for more than 999_999
|
||
|
|
+ microseconds (rt.cpan.org #34655)
|
||
|
|
+ - it seems that HP-UX has started (at least in 11.31 ia64)
|
||
|
|
+ #defining the CLOCK_REALTIME et alia (instead of having
|
||
|
|
+ them just as enums)
|
||
|
|
+ - document all the diagnostics
|
||
|
|
+
|
||
|
|
+1.9712 [2008-02-09]
|
||
|
|
+ - move the sub tick in the test file back to where it used to be
|
||
|
|
+ - in the "consider upgrading" message recommend at least Perl 5.8.8
|
||
|
|
+ and make the message to appear only for 5.8.0 since 5.8.1 and
|
||
|
|
+ later have the problem fixed
|
||
|
|
+ - VOS tweak for Makefile (core perl change #33259)
|
||
|
|
+ - since the test #17 seems to fail often, relax its limits a bit
|
||
|
|
+
|
||
|
|
1.9711 [2007-11-29]
|
||
|
|
- lost VMS test skippage from Craig Berry
|
||
|
|
- reformat the test code a little
|
||
|
|
diff -urN perl-5.10.0.orig/ext/Time/HiRes/HiRes.pm perl-5.10.0/ext/Time/HiRes/HiRes.pm
|
||
|
|
--- perl-5.10.0.orig/ext/Time/HiRes/HiRes.pm 2007-12-18 11:47:07.000000000 +0100
|
||
|
|
+++ perl-5.10.0/ext/Time/HiRes/HiRes.pm 2009-03-10 17:48:02.000000000 +0100
|
||
|
|
@@ -22,8 +22,8 @@
|
||
|
|
d_clock d_clock_nanosleep
|
||
|
|
stat
|
||
|
|
);
|
||
|
|
-
|
||
|
|
-$VERSION = '1.9711';
|
||
|
|
+
|
||
|
|
+$VERSION = '1.9719';
|
||
|
|
$XS_VERSION = $VERSION;
|
||
|
|
$VERSION = eval $VERSION;
|
||
|
|
|
||
|
|
@@ -209,6 +209,9 @@
|
||
|
|
Issues a C<ualarm> call; the C<$interval_useconds> is optional and
|
||
|
|
will be zero if unspecified, resulting in C<alarm>-like behaviour.
|
||
|
|
|
||
|
|
+Returns the remaining time in the alarm in microseconds, or C<undef>
|
||
|
|
+if an error occurred.
|
||
|
|
+
|
||
|
|
ualarm(0) will cancel an outstanding ualarm().
|
||
|
|
|
||
|
|
Note that the interaction between alarms and sleeps is unspecified.
|
||
|
|
@@ -260,10 +263,14 @@
|
||
|
|
=item alarm ( $floating_seconds [, $interval_floating_seconds ] )
|
||
|
|
|
||
|
|
The C<SIGALRM> signal is sent after the specified number of seconds.
|
||
|
|
-Implemented using C<ualarm()>. The C<$interval_floating_seconds> argument
|
||
|
|
-is optional and will be zero if unspecified, resulting in C<alarm()>-like
|
||
|
|
-behaviour. This function can be imported, resulting in a nice drop-in
|
||
|
|
-replacement for the C<alarm> provided with perl, see the L</EXAMPLES> below.
|
||
|
|
+Implemented using C<setitimer()> if available, C<ualarm()> if not.
|
||
|
|
+The C<$interval_floating_seconds> argument is optional and will be
|
||
|
|
+zero if unspecified, resulting in C<alarm()>-like behaviour. This
|
||
|
|
+function can be imported, resulting in a nice drop-in replacement for
|
||
|
|
+the C<alarm> provided with perl, see the L</EXAMPLES> below.
|
||
|
|
+
|
||
|
|
+Returns the remaining time in the alarm in seconds, or C<undef>
|
||
|
|
+if an error occurred.
|
||
|
|
|
||
|
|
B<NOTE 1>: With some combinations of operating systems and Perl
|
||
|
|
releases C<SIGALRM> restarts C<select()>, instead of interrupting it.
|
||
|
|
@@ -292,9 +299,9 @@
|
||
|
|
There are usually three or four interval timers (signals) available: the
|
||
|
|
C<$which> can be C<ITIMER_REAL>, C<ITIMER_VIRTUAL>, C<ITIMER_PROF>, or
|
||
|
|
C<ITIMER_REALPROF>. Note that which ones are available depends: true
|
||
|
|
-UNIX platforms usually have the first three, but (for example) Win32
|
||
|
|
-and Cygwin have only C<ITIMER_REAL>, and only Solaris seems to have
|
||
|
|
-C<ITIMER_REALPROF> (which is used to profile multithreaded programs).
|
||
|
|
+UNIX platforms usually have the first three, but only Solaris seems to
|
||
|
|
+have C<ITIMER_REALPROF> (which is used to profile multithreaded programs).
|
||
|
|
+Win32 unfortunately does not haveinterval timers.
|
||
|
|
|
||
|
|
C<ITIMER_REAL> results in C<alarm()>-like behaviour. Time is counted in
|
||
|
|
I<real time>; that is, wallclock time. C<SIGALRM> is delivered when
|
||
|
|
@@ -337,8 +344,8 @@
|
||
|
|
CLOCK_REALTIME is zero, it might be one, or something else.
|
||
|
|
Another potentially useful (but not available everywhere) value is
|
||
|
|
C<CLOCK_MONOTONIC>, which guarantees a monotonically increasing time
|
||
|
|
-value (unlike time(), which can be adjusted). See your system
|
||
|
|
-documentation for other possibly supported values.
|
||
|
|
+value (unlike time() or gettimeofday(), which can be adjusted).
|
||
|
|
+See your system documentation for other possibly supported values.
|
||
|
|
|
||
|
|
=item clock_getres ( $which )
|
||
|
|
|
||
|
|
@@ -528,6 +535,15 @@
|
||
|
|
Something went horribly wrong-- the number of microseconds that cannot
|
||
|
|
become negative just became negative. Maybe your compiler is broken?
|
||
|
|
|
||
|
|
+=head2 useconds or uinterval equal to or more than 1000000
|
||
|
|
+
|
||
|
|
+In some platforms it is not possible to get an alarm with subsecond
|
||
|
|
+resolution and later than one second.
|
||
|
|
+
|
||
|
|
+=head2 unimplemented in this platform
|
||
|
|
+
|
||
|
|
+Some calls simply aren't available, real or emulated, on every platform.
|
||
|
|
+
|
||
|
|
=head1 CAVEATS
|
||
|
|
|
||
|
|
Notice that the core C<time()> maybe rounding rather than truncating.
|
||
|
|
@@ -544,6 +560,9 @@
|
||
|
|
Note that since Time::HiRes 1.77 the clock_gettime(CLOCK_MONOTONIC)
|
||
|
|
might help in this (in case your system supports CLOCK_MONOTONIC).
|
||
|
|
|
||
|
|
+Some systems have APIs but not implementations: for example QNX and Haiku
|
||
|
|
+have the interval timer APIs but not the functionality.
|
||
|
|
+
|
||
|
|
=head1 SEE ALSO
|
||
|
|
|
||
|
|
Perl modules L<BSD::Resource>, L<Time::TAI64>.
|
||
|
|
@@ -563,7 +582,8 @@
|
||
|
|
|
||
|
|
Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved.
|
||
|
|
|
||
|
|
-Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007 Jarkko Hietaniemi. All rights reserved.
|
||
|
|
+Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007, 2008 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.
|
||
|
|
diff -urN perl-5.10.0.orig/ext/Time/HiRes/HiRes.xs perl-5.10.0/ext/Time/HiRes/HiRes.xs
|
||
|
|
--- perl-5.10.0.orig/ext/Time/HiRes/HiRes.xs 2007-12-18 11:47:07.000000000 +0100
|
||
|
|
+++ perl-5.10.0/ext/Time/HiRes/HiRes.xs 2009-03-10 17:48:02.000000000 +0100
|
||
|
|
@@ -2,7 +2,8 @@
|
||
|
|
*
|
||
|
|
* Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved.
|
||
|
|
*
|
||
|
|
- * Copyright (c) 2002,2003,2004,2005,2006,2007 Jarkko Hietaniemi. All rights reserved.
|
||
|
|
+ * Copyright (c) 2002,2003,2004,2005,2006,2007,2008 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 +38,13 @@
|
||
|
|
}
|
||
|
|
#endif
|
||
|
|
|
||
|
|
+/* At least ppport.h 3.13 gets this wrong: one really cannot
|
||
|
|
+ * have NVgf as anything else than "g" under Perl 5.6.x. */
|
||
|
|
+#if PERL_REVISION == 5 && PERL_VERSION == 6
|
||
|
|
+# undef NVgf
|
||
|
|
+# define NVgf "g"
|
||
|
|
+#endif
|
||
|
|
+
|
||
|
|
#define IV_1E6 1000000
|
||
|
|
#define IV_1E7 10000000
|
||
|
|
#define IV_1E9 1000000000
|
||
|
|
@@ -71,9 +79,13 @@
|
||
|
|
/* 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
|
||
|
|
+/* However, it seems that at least in HP-UX 11.31 ia64 there *are*
|
||
|
|
+ * defines for these, so let's try detecting them. */
|
||
|
|
+# ifndef CLOCK_REALTIME
|
||
|
|
+# define CLOCK_REALTIME CLOCK_REALTIME
|
||
|
|
+# define CLOCK_VIRTUAL CLOCK_VIRTUAL
|
||
|
|
+# define CLOCK_PROFILE CLOCK_PROFILE
|
||
|
|
+# endif
|
||
|
|
# endif /* # ifdef __hpux */
|
||
|
|
|
||
|
|
#endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) */
|
||
|
|
@@ -390,10 +402,10 @@
|
||
|
|
* The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */
|
||
|
|
#if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
|
||
|
|
#define HAS_USLEEP
|
||
|
|
-#define usleep hrt_nanosleep /* could conflict with ncurses for static build */
|
||
|
|
+#define usleep hrt_usleep /* could conflict with ncurses for static build */
|
||
|
|
|
||
|
|
void
|
||
|
|
-hrt_nanosleep(unsigned long usec) /* This is used to emulate usleep. */
|
||
|
|
+hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */
|
||
|
|
{
|
||
|
|
struct timespec res;
|
||
|
|
res.tv_sec = usec / IV_1E6;
|
||
|
|
@@ -433,21 +445,6 @@
|
||
|
|
}
|
||
|
|
#endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
|
||
|
|
|
||
|
|
-#if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
|
||
|
|
-#define HAS_USLEEP
|
||
|
|
-#define usleep hrt_usleep /* could conflict with ncurses for static build */
|
||
|
|
-
|
||
|
|
-void
|
||
|
|
-hrt_usleep(unsigned long usec)
|
||
|
|
-{
|
||
|
|
- struct timespec ts1;
|
||
|
|
- ts1.tv_sec = usec * 1000; /* Ignoring wraparound. */
|
||
|
|
- ts1.tv_nsec = 0;
|
||
|
|
- nanosleep(&ts1, NULL);
|
||
|
|
-}
|
||
|
|
-
|
||
|
|
-#endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
|
||
|
|
-
|
||
|
|
#if !defined(HAS_USLEEP) && defined(HAS_POLL)
|
||
|
|
#define HAS_USLEEP
|
||
|
|
#define usleep hrt_usleep /* could conflict with ncurses for static build */
|
||
|
|
@@ -462,16 +459,24 @@
|
||
|
|
#endif /* #if !defined(HAS_USLEEP) && defined(HAS_POLL) */
|
||
|
|
|
||
|
|
#if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
|
||
|
|
+
|
||
|
|
+static int
|
||
|
|
+hrt_ualarm_itimero(struct itimerval* itv, int usec, int uinterval)
|
||
|
|
+{
|
||
|
|
+ itv->it_value.tv_sec = usec / IV_1E6;
|
||
|
|
+ itv->it_value.tv_usec = usec % IV_1E6;
|
||
|
|
+ itv->it_interval.tv_sec = uinterval / IV_1E6;
|
||
|
|
+ itv->it_interval.tv_usec = uinterval % IV_1E6;
|
||
|
|
+ return setitimer(ITIMER_REAL, itv, 0);
|
||
|
|
+}
|
||
|
|
+
|
||
|
|
int
|
||
|
|
-hrt_ualarm_itimer(int usec, int interval)
|
||
|
|
+hrt_ualarm_itimer(int usec, int uinterval)
|
||
|
|
{
|
||
|
|
- struct itimerval itv;
|
||
|
|
- 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);
|
||
|
|
+ struct itimerval itv;
|
||
|
|
+ return hrt_ualarm_itimero(&itv, usec, uinterval);
|
||
|
|
}
|
||
|
|
+
|
||
|
|
#ifdef HAS_UALARM
|
||
|
|
int
|
||
|
|
hrt_ualarm(int usec, int interval) /* for binary compat before 1.91 */
|
||
|
|
@@ -898,21 +903,27 @@
|
||
|
|
|
||
|
|
#ifdef HAS_UALARM
|
||
|
|
|
||
|
|
-int
|
||
|
|
-ualarm(useconds,interval=0)
|
||
|
|
+IV
|
||
|
|
+ualarm(useconds,uinterval=0)
|
||
|
|
int useconds
|
||
|
|
- int interval
|
||
|
|
+ int uinterval
|
||
|
|
CODE:
|
||
|
|
- if (useconds < 0 || interval < 0)
|
||
|
|
- croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, interval);
|
||
|
|
- if (useconds >= IV_1E6 || interval >= IV_1E6)
|
||
|
|
+ if (useconds < 0 || uinterval < 0)
|
||
|
|
+ croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, uinterval);
|
||
|
|
#if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
|
||
|
|
- RETVAL = hrt_ualarm_itimer(useconds, interval);
|
||
|
|
+ {
|
||
|
|
+ struct itimerval itv;
|
||
|
|
+ if (hrt_ualarm_itimero(&itv, useconds, uinterval)) {
|
||
|
|
+ RETVAL = itv.it_value.tv_sec + IV_1E6 * itv.it_value.tv_usec;
|
||
|
|
+ } else {
|
||
|
|
+ RETVAL = 0;
|
||
|
|
+ }
|
||
|
|
+ }
|
||
|
|
#else
|
||
|
|
- croak("Time::HiRes::ualarm(%d, %d): useconds or interval equal or more than %"IVdf, useconds, interval, IV_1E6);
|
||
|
|
+ if (useconds >= IV_1E6 || uinterval >= IV_1E6)
|
||
|
|
+ croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval equal to or more than %"IVdf, useconds, uinterval, IV_1E6);
|
||
|
|
+ RETVAL = ualarm(useconds, uinterval);
|
||
|
|
#endif
|
||
|
|
- else
|
||
|
|
- RETVAL = ualarm(useconds, interval);
|
||
|
|
|
||
|
|
OUTPUT:
|
||
|
|
RETVAL
|
||
|
|
@@ -924,8 +935,24 @@
|
||
|
|
CODE:
|
||
|
|
if (seconds < 0.0 || interval < 0.0)
|
||
|
|
croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval);
|
||
|
|
- RETVAL = (NV)ualarm((IV)(seconds * IV_1E6),
|
||
|
|
- (IV)(interval * IV_1E6)) / NV_1E6;
|
||
|
|
+ {
|
||
|
|
+ IV useconds = IV_1E6 * seconds;
|
||
|
|
+ IV uinterval = IV_1E6 * interval;
|
||
|
|
+#if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
|
||
|
|
+ {
|
||
|
|
+ struct itimerval itv;
|
||
|
|
+ if (hrt_ualarm_itimero(&itv, useconds, uinterval)) {
|
||
|
|
+ RETVAL = (NV)itv.it_value.tv_sec + (NV)itv.it_value.tv_usec / NV_1E6;
|
||
|
|
+ } else {
|
||
|
|
+ RETVAL = 0;
|
||
|
|
+ }
|
||
|
|
+ }
|
||
|
|
+#else
|
||
|
|
+ if (useconds >= IV_1E6 || uinterval >= IV_1E6)
|
||
|
|
+ croak("Time::HiRes::alarm(%d, %d): seconds or interval equal to or more than 1.0 ", useconds, uinterval, IV_1E6);
|
||
|
|
+ RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6;
|
||
|
|
+#endif
|
||
|
|
+ }
|
||
|
|
|
||
|
|
OUTPUT:
|
||
|
|
RETVAL
|
||
|
|
diff -urN perl-5.10.0.orig/ext/Time/HiRes/Makefile.PL perl-5.10.0/ext/Time/HiRes/Makefile.PL
|
||
|
|
--- perl-5.10.0.orig/ext/Time/HiRes/Makefile.PL 2007-12-18 11:47:07.000000000 +0100
|
||
|
|
+++ perl-5.10.0/ext/Time/HiRes/Makefile.PL 2009-03-10 17:48:02.000000000 +0100
|
||
|
|
@@ -19,8 +19,11 @@
|
||
|
|
|
||
|
|
use vars qw($self); # Used in 'sourcing' the hints.
|
||
|
|
|
||
|
|
+# TBD: Can we just use $Config(exe_ext) here instead of this complex
|
||
|
|
+# expression?
|
||
|
|
my $ld_exeext = ($^O eq 'cygwin' ||
|
||
|
|
- $^O eq 'os2' && $Config{ldflags} =~ /-Zexe\b/) ? '.exe' : '';
|
||
|
|
+ $^O eq 'os2' && $Config{ldflags} =~ /-Zexe\b/) ? '.exe' :
|
||
|
|
+ (($^O eq 'vos') ? $Config{exe_ext} : '');
|
||
|
|
|
||
|
|
unless($ENV{PERL_CORE}) {
|
||
|
|
$ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
|
||
|
|
@@ -829,38 +832,43 @@
|
||
|
|
}
|
||
|
|
|
||
|
|
sub main {
|
||
|
|
- print "Configuring Time::HiRes...\n";
|
||
|
|
- if ($] == 5.007002) {
|
||
|
|
- die "Cannot Configure Time::HiRes for Perl $], aborting.\n";
|
||
|
|
- }
|
||
|
|
-
|
||
|
|
- if ($^O =~ /Win32/i) {
|
||
|
|
- DEFINE('SELECT_IS_BROKEN');
|
||
|
|
- $LIBS = [];
|
||
|
|
- print "System is $^O, skipping full configure...\n";
|
||
|
|
- } else {
|
||
|
|
- init();
|
||
|
|
+ if (-f "xdefine" && !(@ARGV && $ARGV[0] eq '--configure')) {
|
||
|
|
+ print qq[$0: The "xdefine" exists, skipping the configure step.\n];
|
||
|
|
+ print qq[("$^X $0 --configure" to force the configure step)\n];
|
||
|
|
+ } else {
|
||
|
|
+ print "Configuring Time::HiRes...\n";
|
||
|
|
+ 1 while unlink("define");
|
||
|
|
+ if ($^O =~ /Win32/i) {
|
||
|
|
+ DEFINE('SELECT_IS_BROKEN');
|
||
|
|
+ $LIBS = [];
|
||
|
|
+ print "System is $^O, skipping full configure...\n";
|
||
|
|
+ open(XDEFINE, ">xdefine") or die "$0: Cannot create xdefine: $!\n";
|
||
|
|
+ close(XDEFINE);
|
||
|
|
+ } else {
|
||
|
|
+ init();
|
||
|
|
+ }
|
||
|
|
+ doMakefile;
|
||
|
|
+ doConstants;
|
||
|
|
}
|
||
|
|
- doMakefile;
|
||
|
|
- doConstants;
|
||
|
|
my $make = $Config{'make'} || "make";
|
||
|
|
unless (exists $ENV{PERL_CORE} && $ENV{PERL_CORE}) {
|
||
|
|
print <<EOM;
|
||
|
|
Now you may issue '$make'. Do not forget also '$make test'.
|
||
|
|
EOM
|
||
|
|
- if ((exists $ENV{LC_ALL} && $ENV{LC_ALL} =~ /utf-?8/i) ||
|
||
|
|
- (exists $ENV{LC_CTYPE} && $ENV{LC_CTYPE} =~ /utf-?8/i) ||
|
||
|
|
- (exists $ENV{LANG} && $ENV{LANG} =~ /utf-?8/i)) {
|
||
|
|
+ if ($] == 5.008 &&
|
||
|
|
+ ((exists $ENV{LC_ALL} && $ENV{LC_ALL} =~ /utf-?8/i) ||
|
||
|
|
+ (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 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").
|
||
|
|
-(And consider upgrading your Perl.)
|
||
|
|
+(And consider upgrading your Perl to, say, at least Perl 5.8.8.)
|
||
|
|
(You got this message because you seem to have
|
||
|
|
an UTF-8 locale active in your shell environment, this used
|
||
|
|
- to cause broken Makefiles to be created from Makefile.PLs.)
|
||
|
|
+ to cause broken Makefiles to be created from Makefile.PLs)
|
||
|
|
EOM
|
||
|
|
}
|
||
|
|
}
|
||
|
|
diff -urN perl-5.10.0.orig/ext/Time/HiRes/t/HiRes.t perl-5.10.0/ext/Time/HiRes/t/HiRes.t
|
||
|
|
--- perl-5.10.0.orig/ext/Time/HiRes/t/HiRes.t 2007-12-18 11:47:07.000000000 +0100
|
||
|
|
+++ perl-5.10.0/ext/Time/HiRes/t/HiRes.t 2009-03-10 17:48:02.000000000 +0100
|
||
|
|
@@ -12,7 +12,7 @@
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
-BEGIN { $| = 1; print "1..38\n"; }
|
||
|
|
+BEGIN { $| = 1; print "1..40\n"; }
|
||
|
|
|
||
|
|
END { print "not ok 1\n" unless $loaded }
|
||
|
|
|
||
|
|
@@ -68,7 +68,7 @@
|
||
|
|
|
||
|
|
my $have_alarm = $Config{d_alarm};
|
||
|
|
my $have_fork = $Config{d_fork};
|
||
|
|
-my $waitfor = 180; # 30-45 seconds is normal (load affects this).
|
||
|
|
+my $waitfor = 360; # 30-45 seconds is normal (load affects this).
|
||
|
|
my $timer_pid;
|
||
|
|
my $TheEnd;
|
||
|
|
|
||
|
|
@@ -79,11 +79,14 @@
|
||
|
|
if ($timer_pid == 0) { # We are the kid, set up the timer.
|
||
|
|
my $ppid = getppid();
|
||
|
|
print "# I am the timer process $$, sleeping for $waitfor seconds...\n";
|
||
|
|
- sleep($waitfor);
|
||
|
|
- warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n";
|
||
|
|
- print "# Terminating main process $ppid...\n";
|
||
|
|
- kill('TERM', $ppid);
|
||
|
|
- print "# This is the timer process $$, over and out.\n";
|
||
|
|
+ sleep($waitfor - 2); # Workaround for perlbug #49073
|
||
|
|
+ sleep(2); # Wait for parent to exit
|
||
|
|
+ if (kill(0, $ppid)) { # Check if parent still exists
|
||
|
|
+ warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n";
|
||
|
|
+ print "# Terminating main process $ppid...\n";
|
||
|
|
+ kill('KILL', $ppid);
|
||
|
|
+ print "# This is the timer process $$, over and out.\n";
|
||
|
|
+ }
|
||
|
|
exit(0);
|
||
|
|
} else {
|
||
|
|
print "# The timer process $timer_pid launched, continuing testing...\n";
|
||
|
|
@@ -238,10 +241,13 @@
|
||
|
|
|
||
|
|
$has_ualarm ||= $xdefine =~ /-DHAS_UALARM/;
|
||
|
|
|
||
|
|
-unless ( defined &Time::HiRes::gettimeofday
|
||
|
|
- && defined &Time::HiRes::ualarm
|
||
|
|
- && defined &Time::HiRes::usleep
|
||
|
|
- && $has_ualarm) {
|
||
|
|
+my $can_subsecond_alarm =
|
||
|
|
+ defined &Time::HiRes::gettimeofday &&
|
||
|
|
+ defined &Time::HiRes::ualarm &&
|
||
|
|
+ defined &Time::HiRes::usleep &&
|
||
|
|
+ $has_ualarm;
|
||
|
|
+
|
||
|
|
+unless ($can_subsecond_alarm) {
|
||
|
|
for (15..17) {
|
||
|
|
print "ok $_ # Skip: no gettimeofday or no ualarm or no usleep\n";
|
||
|
|
}
|
||
|
|
@@ -271,19 +277,6 @@
|
||
|
|
# Perl's deferred signals may be too wimpy to break through
|
||
|
|
# a restartable select(), so use POSIX::sigaction if available.
|
||
|
|
|
||
|
|
- sub tick {
|
||
|
|
- $i--;
|
||
|
|
- my $ival = Time::HiRes::tv_interval ($r);
|
||
|
|
- print "# Tick! $i $ival\n";
|
||
|
|
- my $exp = 0.3 * (5 - $i);
|
||
|
|
- # This test is more sensitive, so impose a softer limit.
|
||
|
|
- if (abs($ival/$exp - 1) > 4*$limit) {
|
||
|
|
- my $ratio = abs($ival/$exp);
|
||
|
|
- $not = "tick: $exp sleep took $ival ratio $ratio";
|
||
|
|
- $i = 0;
|
||
|
|
- }
|
||
|
|
- }
|
||
|
|
-
|
||
|
|
POSIX::sigaction(&POSIX::SIGALRM,
|
||
|
|
POSIX::SigAction->new("tick"),
|
||
|
|
$oldaction)
|
||
|
|
@@ -314,8 +307,12 @@
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
my $exp = 0.3 * (5 - $i);
|
||
|
|
+ if ($exp == 0) {
|
||
|
|
+ $not = "while: divisor became zero";
|
||
|
|
+ last;
|
||
|
|
+ }
|
||
|
|
# This test is more sensitive, so impose a softer limit.
|
||
|
|
- if (abs($ival/$exp - 1) > 3*$limit) {
|
||
|
|
+ if (abs($ival/$exp - 1) > 4*$limit) {
|
||
|
|
my $ratio = abs($ival/$exp);
|
||
|
|
$not = "while: $exp sleep took $ival ratio $ratio";
|
||
|
|
last;
|
||
|
|
@@ -324,6 +321,23 @@
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
+ sub tick {
|
||
|
|
+ $i--;
|
||
|
|
+ my $ival = Time::HiRes::tv_interval ($r);
|
||
|
|
+ print "# Tick! $i $ival\n";
|
||
|
|
+ my $exp = 0.3 * (5 - $i);
|
||
|
|
+ if ($exp == 0) {
|
||
|
|
+ $not = "tick: divisor became zero";
|
||
|
|
+ last;
|
||
|
|
+ }
|
||
|
|
+ # This test is more sensitive, so impose a softer limit.
|
||
|
|
+ if (abs($ival/$exp - 1) > 4*$limit) {
|
||
|
|
+ my $ratio = abs($ival/$exp);
|
||
|
|
+ $not = "tick: $exp sleep took $ival ratio $ratio";
|
||
|
|
+ $i = 0;
|
||
|
|
+ }
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
if ($use_sigaction) {
|
||
|
|
POSIX::sigaction(&POSIX::SIGALRM, $oldaction);
|
||
|
|
} else {
|
||
|
|
@@ -333,11 +347,13 @@
|
||
|
|
print $not ? "not ok 17 # $not\n" : "ok 17 # $ok\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
-unless ( defined &Time::HiRes::setitimer
|
||
|
|
+unless (defined &Time::HiRes::setitimer
|
||
|
|
&& defined &Time::HiRes::getitimer
|
||
|
|
&& has_symbol('ITIMER_VIRTUAL')
|
||
|
|
&& $Config{sig_name} =~ m/\bVTALRM\b/
|
||
|
|
- && $^O !~ /^(nto)$/) { # nto: QNX 6 has the API but no implementation
|
||
|
|
+ && $^O ne 'nto' # nto: QNX 6 has the API but no implementation
|
||
|
|
+ && $^O ne 'haiku' # haiku: has the API but no implementation
|
||
|
|
+ ) {
|
||
|
|
for (18..19) {
|
||
|
|
print "ok $_ # Skip: no virtual interval timers\n";
|
||
|
|
}
|
||
|
|
@@ -502,13 +518,14 @@
|
||
|
|
};
|
||
|
|
|
||
|
|
# 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)
|
||
|
|
- # 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.
|
||
|
|
+ # Time::HiRes, behind the curtains the libc getitimer() or
|
||
|
|
+ # 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.
|
||
|
|
|
||
|
|
@@ -620,6 +637,16 @@
|
||
|
|
skip 33;
|
||
|
|
}
|
||
|
|
|
||
|
|
+sub bellish { # Cheap emulation of a bell curve.
|
||
|
|
+ my ($min, $max) = @_;
|
||
|
|
+ my $rand = ($max - $min) / 5;
|
||
|
|
+ my $sum = 0;
|
||
|
|
+ for my $i (0..4) {
|
||
|
|
+ $sum += rand($rand);
|
||
|
|
+ }
|
||
|
|
+ return $min + $sum;
|
||
|
|
+}
|
||
|
|
+
|
||
|
|
if ($have_ualarm) {
|
||
|
|
# 1_100_000 sligthly over 1_000_000,
|
||
|
|
# 2_200_000 slightly over 2**31/1000,
|
||
|
|
@@ -629,21 +656,29 @@
|
||
|
|
[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);
|
||
|
|
- print "# r = $r\n";
|
||
|
|
- ok $i,
|
||
|
|
- ($n < 1_000_000 || # Too much noise.
|
||
|
|
- $r >= 0.8 && $r <= 1.6), "ualarm($n) close enough";
|
||
|
|
+ my $ok;
|
||
|
|
+ for my $retry (1..10) {
|
||
|
|
+ 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);
|
||
|
|
+ print "# r = $r\n";
|
||
|
|
+ $ok =
|
||
|
|
+ ($n < 1_000_000 || # Too much noise.
|
||
|
|
+ ($r >= 0.8 && $r <= 1.6));
|
||
|
|
+ last if $ok;
|
||
|
|
+ my $nap = bellish(3, 15);
|
||
|
|
+ printf "# Retrying in %.1f seconds...\n", $nap;
|
||
|
|
+ Time::HiRes::sleep($nap);
|
||
|
|
+ }
|
||
|
|
+ ok $i, $ok, "ualarm($n) close enough";
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
print "# No ualarm\n";
|
||
|
|
@@ -710,12 +745,37 @@
|
||
|
|
skip 38;
|
||
|
|
}
|
||
|
|
|
||
|
|
+unless ($can_subsecond_alarm) {
|
||
|
|
+ skip 39..40;
|
||
|
|
+} else {
|
||
|
|
+ {
|
||
|
|
+ my $alrm;
|
||
|
|
+ $SIG{ALRM} = sub { $alrm++ };
|
||
|
|
+ Time::HiRes::alarm(0.1);
|
||
|
|
+ my $t0 = time();
|
||
|
|
+ 1 while time() - $t0 <= 1;
|
||
|
|
+ print $alrm ? "ok 39\n" : "not ok 39\n";
|
||
|
|
+ }
|
||
|
|
+ {
|
||
|
|
+ my $alrm;
|
||
|
|
+ $SIG{ALRM} = sub { $alrm++ };
|
||
|
|
+ Time::HiRes::alarm(1.1);
|
||
|
|
+ my $t0 = time();
|
||
|
|
+ 1 while time() - $t0 <= 2;
|
||
|
|
+ print $alrm ? "ok 40\n" : "not ok 40\n";
|
||
|
|
+ }
|
||
|
|
+}
|
||
|
|
+
|
||
|
|
END {
|
||
|
|
if ($timer_pid) { # Only in the main process.
|
||
|
|
my $left = $TheEnd - time();
|
||
|
|
printf "# I am the main process $$, terminating the timer process $timer_pid\n# before it terminates me in %d seconds (testing took %d seconds).\n", $left, $waitfor - $left;
|
||
|
|
- my $kill = kill('TERM', $timer_pid); # We are done, the timer can go.
|
||
|
|
- printf "# kill TERM $timer_pid = %d\n", $kill;
|
||
|
|
+ if (kill(0, $timer_pid)) {
|
||
|
|
+ local $? = 0;
|
||
|
|
+ my $kill = kill('KILL', $timer_pid); # We are done, the timer can go.
|
||
|
|
+ wait();
|
||
|
|
+ printf "# kill KILL $timer_pid = %d\n", $kill;
|
||
|
|
+ }
|
||
|
|
unlink("ktrace.out"); # Used in BSD system call tracing.
|
||
|
|
print "# All done.\n";
|
||
|
|
}
|