Change 33717 by [EMAIL PROTECTED] on 2008/04/21 22:03:15
Integrate:
[ 33294]
Upgrade to PathTools-3.2701
[ 33673]
Upgrade to Time::HiRes 1.9715
[ 33699]
Upgrade to Digest::SHA 5.46
(but keep core-compliant test preambles)
Affected files ...
... //depot/maint-5.10/perl/ext/Digest/SHA/Changes#2 integrate
... //depot/maint-5.10/perl/ext/Digest/SHA/README#2 integrate
... //depot/maint-5.10/perl/ext/Digest/SHA/SHA.pm#2 integrate
... //depot/maint-5.10/perl/ext/Digest/SHA/bin/shasum#2 integrate
... //depot/maint-5.10/perl/ext/Digest/SHA/src/hmac.c#2 integrate
... //depot/maint-5.10/perl/ext/Digest/SHA/src/hmac.h#2 integrate
... //depot/maint-5.10/perl/ext/Digest/SHA/src/sha.c#2 integrate
... //depot/maint-5.10/perl/ext/Digest/SHA/src/sha.h#2 integrate
... //depot/maint-5.10/perl/ext/Time/HiRes/Changes#2 integrate
... //depot/maint-5.10/perl/ext/Time/HiRes/HiRes.pm#3 integrate
... //depot/maint-5.10/perl/ext/Time/HiRes/HiRes.xs#2 integrate
... //depot/maint-5.10/perl/ext/Time/HiRes/Makefile.PL#4 integrate
... //depot/maint-5.10/perl/ext/Time/HiRes/t/HiRes.t#3 integrate
... //depot/maint-5.10/perl/lib/Cwd.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Cygwin.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Epoc.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Functions.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Mac.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec/OS2.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Unix.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec/VMS.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec/Win32.pm#3 integrate
... //depot/maint-5.10/perl/lib/File/Spec/t/Spec.t#3 integrate
Differences ...
==== //depot/maint-5.10/perl/ext/Digest/SHA/Changes#2 (text) ====
Index: perl/ext/Digest/SHA/Changes
--- perl/ext/Digest/SHA/Changes#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Digest/SHA/Changes 2008-04-21 15:03:15.000000000 -0700
@@ -1,5 +1,12 @@
Revision history for Perl extension Digest::SHA.
+5.46 Wed Apr 9 05:04:00 MST 2008
+ - modified Addfile to recognize leading and trailing
+ whitespace in filenames (ref. rt.cpan.org #34690)
+ - minor C source code modification (ref. hmac.c)
+ - use const in sha.c for clean builds with -Wwrite-strings
+ -- thanks to Robin Barker for patch
+
5.45 Tue Jun 26 02:36:00 MST 2007
- extended portability to earlier Perls
-- works on Perl 5.003 and later
==== //depot/maint-5.10/perl/ext/Digest/SHA/README#2 (text) ====
Index: perl/ext/Digest/SHA/README
--- perl/ext/Digest/SHA/README#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/Digest/SHA/README 2008-04-21 15:03:15.000000000 -0700
@@ -1,4 +1,4 @@
-Digest::SHA version 5.45
+Digest::SHA version 5.46
========================
Digest::SHA is a complete implementation of the NIST Secure Hash
@@ -34,7 +34,7 @@
COPYRIGHT AND LICENSE
-Copyright (C) 2003-2007 Mark Shelor
+Copyright (C) 2003-2008 Mark Shelor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
==== //depot/maint-5.10/perl/ext/Digest/SHA/SHA.pm#2 (text) ====
Index: perl/ext/Digest/SHA/SHA.pm
--- perl/ext/Digest/SHA/SHA.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/Digest/SHA/SHA.pm 2008-04-21 15:03:15.000000000 -0700
@@ -6,7 +6,7 @@
use integer;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = '5.45';
+$VERSION = '5.46';
require Exporter;
require DynaLoader;
@@ -114,7 +114,10 @@
my $text = -T $file;
local *FH;
- open(FH, "<$file") or _bail("Open failed");
+ # protect any leading or trailing whitespace in $file;
+ # otherwise, 2-arg "open" will ignore them
+ $file =~ s#^(\s)#./$1#;
+ open(FH, "< $file\0") or _bail("Open failed");
binmode(FH) if $binary || $portable;
unless ($portable && $text) {
@@ -655,7 +658,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2003-2007 Mark Shelor
+Copyright (C) 2003-2008 Mark Shelor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
==== //depot/maint-5.10/perl/ext/Digest/SHA/bin/shasum#2 (xtext) ====
Index: perl/ext/Digest/SHA/bin/shasum
--- perl/ext/Digest/SHA/bin/shasum#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Digest/SHA/bin/shasum 2008-04-21 15:03:15.000000000 -0700
@@ -2,10 +2,10 @@
# shasum: filter for computing SHA digests (analogous to sha1sum)
#
- # Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
+ # Copyright (C) 2003-2008 Mark Shelor, All Rights Reserved
#
- # Version: 5.45
- # Tue Jun 26 02:36:00 MST 2007
+ # Version: 5.46
+ # Wed Apr 9 05:04:00 MST 2008
=head1 NAME
@@ -61,7 +61,7 @@
=head1 AUTHOR
-Copyright (c) 2003-2007 Mark Shelor <[EMAIL PROTECTED]>.
+Copyright (c) 2003-2008 Mark Shelor <[EMAIL PROTECTED]>.
=head1 SEE ALSO
@@ -74,7 +74,7 @@
use FileHandle;
use Getopt::Long;
-my $VERSION = "5.45";
+my $VERSION = "5.46";
# Try to use Digest::SHA, since it's faster. If not installed,
==== //depot/maint-5.10/perl/ext/Digest/SHA/src/hmac.c#2 (text) ====
Index: perl/ext/Digest/SHA/src/hmac.c
--- perl/ext/Digest/SHA/src/hmac.c#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Digest/SHA/src/hmac.c 2008-04-21 15:03:15.000000000 -0700
@@ -5,8 +5,8 @@
*
* Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
*
- * Version: 5.45
- * Tue Jun 26 02:36:00 MST 2007
+ * Version: 5.46
+ * Wed Apr 9 05:04:00 MST 2008
*
*/
@@ -94,8 +94,8 @@
/* hmacclose: de-allocates digest object */
int hmacclose(HMAC *h)
{
- shaclose(h->osha);
if (h != NULL) {
+ shaclose(h->osha);
memset(h, 0, sizeof(HMAC));
SHA_free(h);
}
==== //depot/maint-5.10/perl/ext/Digest/SHA/src/hmac.h#2 (text) ====
Index: perl/ext/Digest/SHA/src/hmac.h
--- perl/ext/Digest/SHA/src/hmac.h#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Digest/SHA/src/hmac.h 2008-04-21 15:03:15.000000000 -0700
@@ -5,8 +5,8 @@
*
* Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
*
- * Version: 5.45
- * Tue Jun 26 02:36:00 MST 2007
+ * Version: 5.46
+ * Wed Apr 9 05:04:00 MST 2008
*
*/
==== //depot/maint-5.10/perl/ext/Digest/SHA/src/sha.c#2 (text) ====
Index: perl/ext/Digest/SHA/src/sha.c
--- perl/ext/Digest/SHA/src/sha.c#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Digest/SHA/src/sha.c 2008-04-21 15:03:15.000000000 -0700
@@ -5,8 +5,8 @@
*
* Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
*
- * Version: 5.45
- * Tue Jun 26 02:36:00 MST 2007
+ * Version: 5.46
+ * Wed Apr 9 05:04:00 MST 2008
*
*/
@@ -560,7 +560,7 @@
/* ldvals: checks next line in dump file against tag, and loads values */
static int ldvals(
SHA_FILE *f,
- char *tag,
+ const char *tag,
int type,
void *pval,
int reps,
==== //depot/maint-5.10/perl/ext/Digest/SHA/src/sha.h#2 (text) ====
Index: perl/ext/Digest/SHA/src/sha.h
--- perl/ext/Digest/SHA/src/sha.h#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Digest/SHA/src/sha.h 2008-04-21 15:03:15.000000000 -0700
@@ -5,8 +5,8 @@
*
* Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
*
- * Version: 5.45
- * Tue Jun 26 02:36:00 MST 2007
+ * Version: 5.46
+ * Wed Apr 9 05:04:00 MST 2008
*
*/
==== //depot/maint-5.10/perl/ext/Time/HiRes/Changes#2 (text) ====
Index: perl/ext/Time/HiRes/Changes
--- perl/ext/Time/HiRes/Changes#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Time/HiRes/Changes 2008-04-21 15:03:15.000000000 -0700
@@ -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
==== //depot/maint-5.10/perl/ext/Time/HiRes/HiRes.pm#3 (text) ====
Index: perl/ext/Time/HiRes/HiRes.pm
--- perl/ext/Time/HiRes/HiRes.pm#2~33518~ 2008-03-13 13:50:49.000000000
-0700
+++ perl/ext/Time/HiRes/HiRes.pm 2008-04-21 15:03:15.000000000 -0700
@@ -22,8 +22,8 @@
d_clock d_clock_nanosleep
stat
);
-
-$VERSION = '1.9712';
+
+$VERSION = '1.9715';
$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.
@@ -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.
@@ -563,7 +579,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.
==== //depot/maint-5.10/perl/ext/Time/HiRes/HiRes.xs#2 (text) ====
Index: perl/ext/Time/HiRes/HiRes.xs
--- perl/ext/Time/HiRes/HiRes.xs#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Time/HiRes/HiRes.xs 2008-04-21 15:03:15.000000000 -0700
@@ -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)
*/
@@ -462,16 +474,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 +918,28 @@
#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 @@
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
==== //depot/maint-5.10/perl/ext/Time/HiRes/Makefile.PL#4 (text) ====
Index: perl/ext/Time/HiRes/Makefile.PL
--- perl/ext/Time/HiRes/Makefile.PL#3~33518~ 2008-03-13 13:50:49.000000000
-0700
+++ perl/ext/Time/HiRes/Makefile.PL 2008-04-21 15:03:15.000000000 -0700
@@ -832,20 +832,24 @@
}
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 <<EOM;
==== //depot/maint-5.10/perl/ext/Time/HiRes/t/HiRes.t#3 (text) ====
Index: perl/ext/Time/HiRes/t/HiRes.t
--- perl/ext/Time/HiRes/t/HiRes.t#2~33518~ 2008-03-13 13:50:49.000000000
-0700
+++ perl/ext/Time/HiRes/t/HiRes.t 2008-04-21 15:03:15.000000000 -0700
@@ -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;
@@ -502,13 +502,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 +621,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 +640,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";
==== //depot/maint-5.10/perl/lib/Cwd.pm#3 (text) ====
Index: perl/lib/Cwd.pm
--- perl/lib/Cwd.pm#2~33114~ 2008-01-29 15:06:17.000000000 -0800
+++ perl/lib/Cwd.pm 2008-04-21 15:03:15.000000000 -0700
@@ -171,7 +171,7 @@
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-$VERSION = '3.27';
+$VERSION = '3.2701';
@ISA = qw/ Exporter /;
@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
==== //depot/maint-5.10/perl/lib/File/Spec.pm#3 (text) ====
Index: perl/lib/File/Spec.pm
--- perl/lib/File/Spec.pm#2~33114~ 2008-01-29 15:06:17.000000000 -0800
+++ perl/lib/File/Spec.pm 2008-04-21 15:03:15.000000000 -0700
@@ -3,7 +3,7 @@
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = '3.27';
+$VERSION = '3.2701';
$VERSION = eval $VERSION;
my %module = (MacOS => 'Mac',
==== //depot/maint-5.10/perl/lib/File/Spec/Cygwin.pm#3 (text) ====
Index: perl/lib/File/Spec/Cygwin.pm
--- perl/lib/File/Spec/Cygwin.pm#2~33114~ 2008-01-29 15:06:17.000000000
-0800
+++ perl/lib/File/Spec/Cygwin.pm 2008-04-21 15:03:15.000000000 -0700
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.27';
+$VERSION = '3.2701';
@ISA = qw(File::Spec::Unix);
==== //depot/maint-5.10/perl/lib/File/Spec/Epoc.pm#3 (text) ====
Index: perl/lib/File/Spec/Epoc.pm
--- perl/lib/File/Spec/Epoc.pm#2~33114~ 2008-01-29 15:06:17.000000000 -0800
+++ perl/lib/File/Spec/Epoc.pm 2008-04-21 15:03:15.000000000 -0700
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '3.27';
+$VERSION = '3.2701';
require File::Spec::Unix;
@ISA = qw(File::Spec::Unix);
==== //depot/maint-5.10/perl/lib/File/Spec/Functions.pm#3 (text) ====
Index: perl/lib/File/Spec/Functions.pm
--- perl/lib/File/Spec/Functions.pm#2~33114~ 2008-01-29 15:06:17.000000000
-0800
+++ perl/lib/File/Spec/Functions.pm 2008-04-21 15:03:15.000000000 -0700
@@ -5,7 +5,7 @@
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
-$VERSION = '3.27';
+$VERSION = '3.2701';
require Exporter;
==== //depot/maint-5.10/perl/lib/File/Spec/Mac.pm#3 (text) ====
Index: perl/lib/File/Spec/Mac.pm
--- perl/lib/File/Spec/Mac.pm#2~33114~ 2008-01-29 15:06:17.000000000 -0800
+++ perl/lib/File/Spec/Mac.pm 2008-04-21 15:03:15.000000000 -0700
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.27';
+$VERSION = '3.2701';
@ISA = qw(File::Spec::Unix);
==== //depot/maint-5.10/perl/lib/File/Spec/OS2.pm#3 (text) ====
Index: perl/lib/File/Spec/OS2.pm
--- perl/lib/File/Spec/OS2.pm#2~33114~ 2008-01-29 15:06:17.000000000 -0800
+++ perl/lib/File/Spec/OS2.pm 2008-04-21 15:03:15.000000000 -0700
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.27';
+$VERSION = '3.2701';
@ISA = qw(File::Spec::Unix);
==== //depot/maint-5.10/perl/lib/File/Spec/Unix.pm#3 (text) ====
Index: perl/lib/File/Spec/Unix.pm
--- perl/lib/File/Spec/Unix.pm#2~33114~ 2008-01-29 15:06:17.000000000 -0800
+++ perl/lib/File/Spec/Unix.pm 2008-04-21 15:03:15.000000000 -0700
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = '3.27';
+$VERSION = '3.2701';
=head1 NAME
==== //depot/maint-5.10/perl/lib/File/Spec/VMS.pm#3 (text) ====
Index: perl/lib/File/Spec/VMS.pm
--- perl/lib/File/Spec/VMS.pm#2~33114~ 2008-01-29 15:06:17.000000000 -0800
+++ perl/lib/File/Spec/VMS.pm 2008-04-21 15:03:15.000000000 -0700
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.27';
+$VERSION = '3.2701';
@ISA = qw(File::Spec::Unix);
==== //depot/maint-5.10/perl/lib/File/Spec/Win32.pm#3 (text) ====
Index: perl/lib/File/Spec/Win32.pm
--- perl/lib/File/Spec/Win32.pm#2~33114~ 2008-01-29 15:06:17.000000000
-0800
+++ perl/lib/File/Spec/Win32.pm 2008-04-21 15:03:15.000000000 -0700
@@ -5,7 +5,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.27';
+$VERSION = '3.2701';
@ISA = qw(File::Spec::Unix);
@@ -133,6 +133,11 @@
shift, return _canon_cat( "/", @_ )
if $_[0] eq "";
+ # Compatibility with File::Spec <= 3.26:
+ # catfile('A:', 'foo') should return 'A:\foo'.
+ return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
+ if $_[0] =~ m{^$DRIVE_RX\z}o;
+
return _canon_cat( @_ );
}
@@ -146,6 +151,11 @@
shift, return _canon_cat( "/", @_ )
if $_[0] eq "";
+ # Compatibility with File::Spec <= 3.26:
+ # catdir('A:', 'foo') should return 'A:\foo'.
+ return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
+ if $_[0] =~ m{^$DRIVE_RX\z}o;
+
return _canon_cat( @_ );
}
==== //depot/maint-5.10/perl/lib/File/Spec/t/Spec.t#3 (text) ====
Index: perl/lib/File/Spec/t/Spec.t
--- perl/lib/File/Spec/t/Spec.t#2~33114~ 2008-01-29 15:06:17.000000000
-0800
+++ perl/lib/File/Spec/t/Spec.t 2008-04-21 15:03:15.000000000 -0700
@@ -207,6 +207,7 @@
[ "Win32->catdir('A:/')", 'A:\\' ],
[ "Win32->catdir('\\', 'foo')", '\\foo' ],
[ "Win32->catdir('','','..')", '\\' ],
+[ "Win32->catdir('A:', 'foo')", 'A:\\foo' ],
[ "Win32->catfile('a','b','c')", 'a\\b\\c' ],
[ "Win32->catfile('a','b','.\\c')", 'a\\b\\c' ],
@@ -214,6 +215,7 @@
[ "Win32->catfile('c')", 'c' ],
[ "Win32->catfile('.\\c')", 'c' ],
[ "Win32->catfile('a/..','../b')", '..\\b' ],
+[ "Win32->catfile('A:', 'foo')", 'A:\\foo' ],
[ "Win32->canonpath('')", '' ],
End of Patch.
