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 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 @@ =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. @@ -292,9 +299,9 @@ There are usually three or four interval timers (signals) available: the C<$which> can be C, C, C, or C. Note that which ones are available depends: true -UNIX platforms usually have the first three, but (for example) Win32 -and Cygwin have only C, and only Solaris seems to have -C (which is used to profile multithreaded programs). +UNIX platforms usually have the first three, but only Solaris seems to +have C (which is used to profile multithreaded programs). +Win32 unfortunately does not haveinterval timers. C results in C-like behaviour. Time is counted in I; that is, wallclock time. C 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, 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 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, L. @@ -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 < 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"; }