From: Rafael Garcia-Suarez Date: Sun, 13 Apr 2008 14:02:38 +0000 (+0000) Subject: Upgrade to Time::HiRes 1.9715 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf8300decce77d53edc393ca2221fb591a778c59;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Time::HiRes 1.9715 p4raw-id: //depot/perl@33673 --- diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index 1a3ba96..d710323 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,5 +1,42 @@ Revision history for the Perl extension Time::HiRes. +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 --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index ce7b336..8b7d2a6 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -22,8 +22,8 @@ require DynaLoader; d_clock d_clock_nanosleep stat ); - -$VERSION = '1.9712'; + +$VERSION = '1.9715'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -209,6 +209,9 @@ Getting even accuracy of one thousand nanoseconds is good. Issues a C call; the C<$interval_useconds> is optional and will be zero if unspecified, resulting in C-like behaviour. +Returns the remaining time in the alarm in microseconds, or C +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 @@ Note that the interaction between alarms and sleeps is unspecified. =item alarm ( $floating_seconds [, $interval_floating_seconds ] ) The C signal is sent after the specified number of seconds. -Implemented using C. The C<$interval_floating_seconds> argument -is optional and will be zero if unspecified, resulting in C-like -behaviour. This function can be imported, resulting in a nice drop-in -replacement for the C provided with perl, see the L below. +Implemented using C if available, C if not. +The C<$interval_floating_seconds> argument is optional and will be +zero if unspecified, resulting in C-like behaviour. This +function can be imported, resulting in a nice drop-in replacement for +the C provided with perl, see the L below. + +Returns the remaining time in the alarm in seconds, or C +if an error occurred. B: With some combinations of operating systems and Perl releases C restarts C, instead of interrupting it. @@ -528,6 +535,15 @@ You tried to use a negative time argument. 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 maybe rounding rather than truncating. @@ -563,7 +579,8 @@ G. Aas 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 --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index 25c5633..ec1ff8b 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -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 @@ extern "C" { } #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 @@ extern "C" { /* 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) */ @@ -462,16 +474,24 @@ hrt_usleep(unsigned long usec) #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 +918,28 @@ usleep(useconds) #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 (useconds >= IV_1E6 || uinterval >= IV_1E6) #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); + croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval equal to or more than %"IVdf, useconds, uinterval, IV_1E6); #endif else - RETVAL = ualarm(useconds, interval); + RETVAL = ualarm(useconds, uinterval); OUTPUT: RETVAL @@ -924,8 +951,24 @@ alarm(seconds,interval=0) 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 (seconds >= IV_1E6 || interval >= IV_1E6) +#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 + RETVAL = (NV)ualarm((IV)(seconds * IV_1E6), + (IV)(interval * IV_1E6)) / NV_1E6; +#endif + } OUTPUT: RETVAL diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL index 28ca521..2ba8ebf 100644 --- a/ext/Time/HiRes/Makefile.PL +++ b/ext/Time/HiRes/Makefile.PL @@ -832,20 +832,24 @@ sub doConstants { } 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"; + if (-f "xdefine" && !(@ARGV && $ARGV[0] eq '--configure')) { + print qq[$0: The "xdefine" exists, skipping the configure step.\n]; + print qq[("$0 --configure" to force the configure step)\n]; } else { - init(); + 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 <= 5.008001) { }; # 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 +621,16 @@ if ($have_clock) { 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 +640,29 @@ if ($have_ualarm) { [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";