Change 33955 by [EMAIL PROTECTED] on 2008/05/31 01:54:46
Integrate:
[ 33851]
Fix for [perl #51848] Deparse interpolation in regex literal
[ 33854]
DEBUG_LEAKING_SCALARS wasn't reporting the correct line number
of SVs allocated at runtime
[ 33869]
Subject: [PATCH] correct errors / omissions in documenting DOES
From: Ricardo SIGNES <[EMAIL PROTECTED]>
Date: Mon, 19 May 2008 10:14:02 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 33874]
Subject: Re: [PATCH: TODO Tests] Re: [perl #53806] No complain about
bareword
From: "Rafael Garcia-Suarez" <[EMAIL PROTECTED]>
Date: Tue, 20 May 2008 09:45:19 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 33876]
Subject: Re: [PATCH: TODO Tests] Re: [perl #53806] No complain about
bareword
From: "Rafael Garcia-Suarez" <[EMAIL PROTECTED]>
Date: Tue, 20 May 2008 10:14:28 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 33890]
The TODO tests of change 33876 were actually fixed by change 33874.
[ 33896]
Eliminate POSIX::int_macro_int, and all the complex AUTOLOAD fandango
that creates closures round it. Instead, wrap WEXITSTATUS, WIFEXITED,
WIFSIGNALED, WIFSTOPPED, WSTOPSIG and WTERMSIG directly with XS.
The shared library is slightly larger, but dynamic memory usage savings
beat this, even within one thread of one process. Simpler code too.
[ 33897]
Replaced the WEXITSTATUS, WIFEXITED, WIFSIGNALED, WIFSTOPPED, WSTOPSIG
and WTERMSIG wrappers with one wrapper using the XS "ALIAS" feature.
This gets the shared object size back below the size before the removal
of int_macro_int. It looks like there are other space savings to be
made this way.
[ 33898]
Subject: Re: [perl #54566] assertion failure fiddling with @ISA
From: "Rafael Garcia-Suarez" <[EMAIL PROTECTED]>
Date: Wed, 21 May 2008 14:42:48 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 33909]
Subject: [DOC PATCH] Memoize.pm refers to old title of "Higher Order
Perl"
From: Moritz Lenz <[EMAIL PROTECTED]>
Date: Thu, 22 May 2008 15:47:04 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 33927]
Subject: [PATCH] lib.pm should not warn about loading .par files
From: Paul Fenwick <[EMAIL PROTECTED]>
Date: Thu, 22 May 2008 23:24:34 +1000
Message-ID: <[EMAIL PROTECTED]>
[ 33936]
My recent changes to POSIX.xs forgot that WEXITSTATUS etc may not even
be defined. This fix changes the error message from "Your vendor has
not defined POSIX macro %s, used" to "POSIX::%s not implemented on
this architecture", which I assume is not going to break anything.
[ 33937]
[perl #54758] Perl 5.10 memory corruption
When @a = sort @a is pessimised if @a has magic,
growing the stack requires various pointers to be reset in case
the stack gets reallocated.
[ 33939]
Revert part of #31039
[ 33949]
Subject: [PATCH] Propagate new i_gdbm*ndbm variables
From: Andy Dougherty <[EMAIL PROTECTED]>
Date: Thu, 29 May 2008 12:43:29 -0400 (EDT)
Message-ID: <[EMAIL PROTECTED]>
[ 33951]
Add index() tests for embedded nulls
Subject: Re: [perl #53746] bug with index() matching beyond end of
string when \0 bytes (00000000) are involved
From: Abigail <[EMAIL PROTECTED]>
Date: Tue, 6 May 2008 14:57:36 +0200
Message-Id: <[EMAIL PROTECTED]>
[ 33952]
[perl #53746] bug with index() matching beyond end of string
An off-by-one error meant that index($str,...)
was effectively being executed as index("$str\0", ...).
Probably introduced by change #26511.
Affected files ...
... //depot/maint-5.10/perl/Configure#10 integrate
... //depot/maint-5.10/perl/Cross/config.sh-arm-linux#6 integrate
... //depot/maint-5.10/perl/NetWare/config.wc#6 integrate
... //depot/maint-5.10/perl/Porting/config.sh#6 integrate
... //depot/maint-5.10/perl/configure.com#9 integrate
... //depot/maint-5.10/perl/epoc/config.sh#6 integrate
... //depot/maint-5.10/perl/ext/B/B/Deparse.pm#7 integrate
... //depot/maint-5.10/perl/ext/B/t/concise-xs.t#3 integrate
... //depot/maint-5.10/perl/ext/B/t/deparse.t#6 integrate
... //depot/maint-5.10/perl/ext/POSIX/POSIX.pm#4 integrate
... //depot/maint-5.10/perl/ext/POSIX/POSIX.xs#4 integrate
... //depot/maint-5.10/perl/lib/Memoize.pm#2 integrate
... //depot/maint-5.10/perl/lib/UNIVERSAL.pm#2 integrate
... //depot/maint-5.10/perl/lib/lib_pm.PL#2 integrate
... //depot/maint-5.10/perl/lib/strict.t#2 integrate
... //depot/maint-5.10/perl/mg.c#13 integrate
... //depot/maint-5.10/perl/plan9/config_sh.sample#6 integrate
... //depot/maint-5.10/perl/pod/perlobj.pod#2 integrate
... //depot/maint-5.10/perl/pod/perltodo.pod#12 integrate
... //depot/maint-5.10/perl/pp_sort.c#2 integrate
... //depot/maint-5.10/perl/sv.c#19 integrate
... //depot/maint-5.10/perl/symbian/config.sh#6 integrate
... //depot/maint-5.10/perl/t/lib/strict/subs#2 integrate
... //depot/maint-5.10/perl/t/op/index.t#3 integrate
... //depot/maint-5.10/perl/toke.c#8 integrate
... //depot/maint-5.10/perl/uconfig.sh#7 integrate
... //depot/maint-5.10/perl/util.c#5 integrate
... //depot/maint-5.10/perl/win32/config.bc#6 integrate
... //depot/maint-5.10/perl/win32/config.ce#6 integrate
... //depot/maint-5.10/perl/win32/config.gc#7 integrate
... //depot/maint-5.10/perl/win32/config.vc#7 integrate
... //depot/maint-5.10/perl/win32/config.vc64#7 integrate
Differences ...
==== //depot/maint-5.10/perl/Configure#10 (xtext) ====
Index: perl/Configure
--- perl/Configure#9~33904~ 2008-05-21 09:37:54.000000000 -0700
+++ perl/Configure 2008-05-30 18:54:46.000000000 -0700
@@ -25,7 +25,7 @@
# $Id: Head.U 6 2006-08-25 22:21:46Z rmanfredi $
#
-# Generated on Tue May 20 17:29:22 CEST 2008 [metaconfig 3.5 PL0]
+# Generated on Tue May 27 17:17:47 CEST 2008 [metaconfig 3.5 PL0]
# (with additional metaconfig patches by [EMAIL PROTECTED])
cat >c1$$ <<EOF
@@ -19093,7 +19093,7 @@
fi
fi
fi
- $rm_try
+ $rm -f core try.core core.try.*
case "$fflushNULL" in
x) $cat >&4 <<EOM
Your fflush(NULL) works okay for output streams.
==== //depot/maint-5.10/perl/Cross/config.sh-arm-linux#6 (text) ====
Index: perl/Cross/config.sh-arm-linux
--- perl/Cross/config.sh-arm-linux#5~33894~ 2008-05-20 16:39:57.000000000
-0700
+++ perl/Cross/config.sh-arm-linux 2008-05-30 18:54:46.000000000 -0700
@@ -625,6 +625,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='define'
i_ieeefp='undef'
i_inttypes='define'
==== //depot/maint-5.10/perl/NetWare/config.wc#6 (text) ====
Index: perl/NetWare/config.wc
--- perl/NetWare/config.wc#5~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/NetWare/config.wc 2008-05-30 18:54:46.000000000 -0700
@@ -608,6 +608,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
==== //depot/maint-5.10/perl/Porting/config.sh#6 (text) ====
Index: perl/Porting/config.sh
--- perl/Porting/config.sh#5~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/Porting/config.sh 2008-05-30 18:54:46.000000000 -0700
@@ -638,6 +638,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='define'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='define'
i_ieeefp='undef'
i_inttypes='define'
==== //depot/maint-5.10/perl/configure.com#9 (text) ====
Index: perl/configure.com
--- perl/configure.com#8~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/configure.com 2008-05-30 18:54:46.000000000 -0700
@@ -6232,6 +6232,8 @@
$ WC "i_fp='undef'"
$ WC "i_fp_class='undef'"
$ WC "i_gdbm='undef'"
+$ WC "i_gdbm_ndbm='undef'"
+$ WC "i_gdbmndbm='undef'"
$ WC "i_grp='" + i_grp + "'"
$ WC "i_ieeefp='undef'"
$ WC "i_inttypes='" + i_inttypes + "'"
==== //depot/maint-5.10/perl/epoc/config.sh#6 (text) ====
Index: perl/epoc/config.sh
--- perl/epoc/config.sh#5~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/epoc/config.sh 2008-05-30 18:54:46.000000000 -0700
@@ -571,6 +571,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
==== //depot/maint-5.10/perl/ext/B/B/Deparse.pm#7 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm#6~33947~ 2008-05-28 18:09:23.000000000 -0700
+++ perl/ext/B/B/Deparse.pm 2008-05-30 18:54:46.000000000 -0700
@@ -4062,6 +4062,16 @@
return "tr" . double_delim($from, $to) . $flags;
}
+sub re_dq_disambiguate {
+ my ($first, $last) = @_;
+ # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
+ ($last =~ /^[A-Z\\\^\[\]_?]/ &&
+ $first =~ s/([EMAIL PROTECTED])\^$/${1}{^}/) # "${^}W" etc
+ || ($last =~ /^[{\[\w_]/ &&
+ $first =~ s/([EMAIL PROTECTED])([A-Za-z_]\w*)$/${1}{$2}/);
+ return $first . $last;
+}
+
# Like dq(), but different
sub re_dq {
my $self = shift;
@@ -4077,14 +4087,7 @@
} elsif ($type eq "concat") {
my $first = $self->re_dq($op->first, $extended);
my $last = $self->re_dq($op->last, $extended);
-
- # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
- ($last =~ /^[A-Z\\\^\[\]_?]/ &&
- $first =~ s/([EMAIL PROTECTED])\^$/${1}{^}/) # "${^}W" etc
- || ($last =~ /^[{\[\w_]/ &&
- $first =~ s/([EMAIL PROTECTED])([A-Za-z_]\w*)$/${1}{$2}/);
-
- return $first . $last;
+ return re_dq_disambiguate($first, $last);
} elsif ($type eq "uc") {
return '\U' . $self->re_dq($op->first->sibling, $extended) . '\E';
} elsif ($type eq "lc") {
@@ -4156,7 +4159,9 @@
my $str = '';
$kid = $kid->first->sibling;
while (!null($kid)) {
- $str .= $self->re_dq($kid, $extended);
+ my $first = $str;
+ my $last = $self->re_dq($kid, $extended);
+ $str = re_dq_disambiguate($first, $last);
$kid = $kid->sibling;
}
return $str, 1;
==== //depot/maint-5.10/perl/ext/B/t/concise-xs.t#3 (text) ====
Index: perl/ext/B/t/concise-xs.t
--- perl/ext/B/t/concise-xs.t#2~33881~ 2008-05-20 05:48:04.000000000 -0700
+++ perl/ext/B/t/concise-xs.t 2008-05-30 18:54:46.000000000 -0700
@@ -180,7 +180,13 @@
skip => [qw/ _POSIX_JOB_CONTROL /, # platform varying
# Might be XS or imported from Fcntl, depending on your
# perl version:
- qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /],
+ qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /,
+ # Might be XS or AUTOLOADed, depending on your perl
+ # version:
+ qw /WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
+ WSTOPSIG WTERMSIG/,
+ 'int_macro_int', # Removed in POSIX 1.16
+ ],
perl => [qw/ import croak AUTOLOAD /],
XS => [qw/ write wctomb wcstombs uname tzset tzname
@@ -194,7 +200,7 @@
mblen lseek log10 localeconv ldexp lchown
isxdigit isupper isspace ispunct isprint
islower isgraph isdigit iscntrl isalpha
- isalnum int_macro_int getcwd frexp fpathconf
+ isalnum getcwd frexp fpathconf
fmod floor dup2 dup difftime cuserid ctime
ctermid cosh constant close clock ceil
bootstrap atan asin asctime acos access abort
==== //depot/maint-5.10/perl/ext/B/t/deparse.t#6 (text) ====
Index: perl/ext/B/t/deparse.t
--- perl/ext/B/t/deparse.t#5~33947~ 2008-05-28 18:09:23.000000000 -0700
+++ perl/ext/B/t/deparse.t 2008-05-30 18:54:46.000000000 -0700
@@ -27,7 +27,7 @@
require feature;
feature->import(':5.10');
}
-use Test::More tests => 60;
+use Test::More tests => 61;
use B::Deparse;
my $deparse = B::Deparse->new();
@@ -416,3 +416,7 @@
elsif ($a and $b) { x(); }
elsif ($a or $b) { x(); }
else { x(); }
+####
+# 54 interpolation in regexps
+my($y, $t);
+/x${y}z$t/;
==== //depot/maint-5.10/perl/ext/POSIX/POSIX.pm#4 (text) ====
Index: perl/ext/POSIX/POSIX.pm
--- perl/ext/POSIX/POSIX.pm#3~33881~ 2008-05-20 05:48:04.000000000 -0700
+++ perl/ext/POSIX/POSIX.pm 2008-05-30 18:54:46.000000000 -0700
@@ -4,7 +4,7 @@
our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();
-our $VERSION = "1.15";
+our $VERSION = "1.16";
use AutoLoader;
@@ -35,10 +35,6 @@
XSLoader::load 'POSIX', $VERSION;
-my %NON_CONSTS
- = (map {($_,1)} qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG
- WTERMSIG));
-
sub AUTOLOAD {
no strict;
no warnings 'uninitialized';
@@ -50,15 +46,9 @@
local $! = 0;
my $constname = $AUTOLOAD;
$constname =~ s/.*:://;
- if ($NON_CONSTS{$constname}) {
- my ($val, $error) = &int_macro_int($constname, $_[0]);
- croak $error if $error;
- *$AUTOLOAD = sub { &int_macro_int($constname, $_[0]) };
- } else {
- my ($error, $val) = constant($constname);
- croak $error if $error;
- *$AUTOLOAD = sub { $val };
- }
+ my ($error, $val) = constant($constname);
+ croak $error if $error;
+ *$AUTOLOAD = sub { $val };
goto &$AUTOLOAD;
}
==== //depot/maint-5.10/perl/ext/POSIX/POSIX.xs#4 (text) ====
Index: perl/ext/POSIX/POSIX.xs
--- perl/ext/POSIX/POSIX.xs#3~33881~ 2008-05-20 05:48:04.000000000 -0700
+++ perl/ext/POSIX/POSIX.xs 2008-05-30 18:54:46.000000000 -0700
@@ -394,116 +394,6 @@
#include "const-c.inc"
-/* These were implemented in the old "constant" subroutine. They are actually
- macros that take an integer argument and return an integer result. */
-static int
-int_macro_int (const char *name, STRLEN len, IV *arg_result) {
- /* Initially switch on the length of the name. */
- /* This code has been edited from a "constant" function generated by:
-
-use ExtUtils::Constant qw (constant_types C_constant XS_constant);
-
-my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(WEXITSTATUS WIFEXITED
- WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
-
-print constant_types(); # macro defs
-foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names)
) {
- print $_, "\n"; # C constant subs
-}
-print "#### XS Section:\n";
-print XS_constant ("POSIX", $types);
- */
-
- switch (len) {
- case 8:
- /* Names all of length 8. */
- /* WSTOPSIG WTERMSIG */
- /* Offset 1 gives the best switch position. */
- switch (name[1]) {
- case 'S':
- if (memEQ(name, "WSTOPSIG", 8)) {
- /* ^ */
-#ifdef WSTOPSIG
- int i = *arg_result;
- *arg_result = WSTOPSIG(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 'T':
- if (memEQ(name, "WTERMSIG", 8)) {
- /* ^ */
-#ifdef WTERMSIG
- int i = *arg_result;
- *arg_result = WTERMSIG(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- }
- break;
- case 9:
- if (memEQ(name, "WIFEXITED", 9)) {
-#ifdef WIFEXITED
- int i = *arg_result;
- *arg_result = WIFEXITED(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 10:
- if (memEQ(name, "WIFSTOPPED", 10)) {
-#ifdef WIFSTOPPED
- int i = *arg_result;
- *arg_result = WIFSTOPPED(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 11:
- /* Names all of length 11. */
- /* WEXITSTATUS WIFSIGNALED */
- /* Offset 1 gives the best switch position. */
- switch (name[1]) {
- case 'E':
- if (memEQ(name, "WEXITSTATUS", 11)) {
- /* ^ */
-#ifdef WEXITSTATUS
- int i = *arg_result;
- *arg_result = WEXITSTATUS(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 'I':
- if (memEQ(name, "WIFSIGNALED", 11)) {
- /* ^ */
-#ifdef WIFSIGNALED
- int i = *arg_result;
- *arg_result = WIFSIGNALED(WMUNGE(i));
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- }
- break;
- }
- return PERL_constant_NOTFOUND;
-}
-
static void
restore_sigmask(pTHX_ SV *osset_sv)
{
@@ -756,47 +646,64 @@
INCLUDE: const-xs.inc
-void
-int_macro_int(sv, iv)
- PREINIT:
- dXSTARG;
- STRLEN len;
- int type;
- INPUT:
- SV * sv;
- const char * s = SvPV(sv, len);
- IV iv;
- PPCODE:
- /* Change this to int_macro_int(s, len, &iv, &nv);
- if you need to return both NVs and IVs */
- type = int_macro_int(s, len, &iv);
- /* Return 1 or 2 items. First is error message, or undef if no error.
- Second, if present, is found value */
- switch (type) {
- case PERL_constant_NOTFOUND:
- sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
- EXTEND(SP, 1);
- PUSHs(&PL_sv_undef);
- PUSHs(sv);
- break;
- case PERL_constant_NOTDEF:
- sv = sv_2mortal(newSVpvf(
- "Your vendor has not defined POSIX macro %s, used", s));
- EXTEND(SP, 1);
- PUSHs(&PL_sv_undef);
- PUSHs(sv);
- break;
- case PERL_constant_ISIV:
- PUSHi(iv);
- break;
- default:
- sv = sv_2mortal(newSVpvf(
- "Unexpected return type %d while processing POSIX macro %s, used",
- type, s));
- EXTEND(SP, 1);
- PUSHs(&PL_sv_undef);
- PUSHs(sv);
- }
+int
+WEXITSTATUS(status)
+ int status
+ ALIAS:
+ POSIX::WIFEXITED = 1
+ POSIX::WIFSIGNALED = 2
+ POSIX::WIFSTOPPED = 3
+ POSIX::WSTOPSIG = 4
+ POSIX::WTERMSIG = 5
+ CODE:
+ switch(ix) {
+ case 0:
+#ifdef WEXITSTATUS
+ RETVAL = WEXITSTATUS(status);
+#else
+ not_here("WEXITSTATUS");
+#endif
+ break;
+ case 1:
+#ifdef WIFEXITED
+ RETVAL = WIFEXITED(status);
+#else
+ not_here("WIFEXITED");
+#endif
+ break;
+ case 2:
+#ifdef WIFSIGNALED
+ RETVAL = WIFSIGNALED(status);
+#else
+ not_here("WIFSIGNALED");
+#endif
+ break;
+ case 3:
+#ifdef WIFSTOPPED
+ RETVAL = WIFSTOPPED(status);
+#else
+ not_here("WIFSTOPPED");
+#endif
+ break;
+ case 4:
+#ifdef WSTOPSIG
+ RETVAL = WSTOPSIG(status);
+#else
+ not_here("WSTOPSIG");
+#endif
+ break;
+ case 5:
+#ifdef WTERMSIG
+ RETVAL = WTERMSIG(status);
+#else
+ not_here("WTERMSIG");
+#endif
+ break;
+ default:
+ Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", ix);
+ }
+ OUTPUT:
+ RETVAL
int
isalnum(charstring)
==== //depot/maint-5.10/perl/lib/Memoize.pm#2 (text) ====
Index: perl/lib/Memoize.pm
--- perl/lib/Memoize.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Memoize.pm 2008-05-30 18:54:46.000000000 -0700
@@ -1003,11 +1003,10 @@
Perl Journal, issue #13. (This article is also included in the
Memoize distribution as `article.html'.)
-My upcoming book will discuss memoization (and many other fascinating
-topics) in tremendous detail. It will be published by Morgan Kaufmann
-in 2002, possibly under the title I<Perl Advanced Techniques
-Handbook>. It will also be available on-line for free. For more
-information, visit http://perl.plover.com/book/ .
+The author's book I<Higher Order Perl> (2005, ISBN 1558607013, published
+by Morgan Kaufmann) discusses memoization (and many other fascinating
+topics) in tremendous detail. It will also be available on-line for free.
+For more information, visit http://perl.plover.com/book/ .
To join a mailing list for announcements about C<Memoize>, send an
empty message to C<[EMAIL PROTECTED]>. This mailing
==== //depot/maint-5.10/perl/lib/UNIVERSAL.pm#2 (text) ====
Index: perl/lib/UNIVERSAL.pm
--- perl/lib/UNIVERSAL.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/UNIVERSAL.pm 2008-05-30 18:54:46.000000000 -0700
@@ -117,8 +117,9 @@
mandates an inheritance relationship. Other relationships include aggregation,
delegation, and mocking.)
-By default, classes in Perl only perform the C<UNIVERSAL> role. To mark that
-your own classes perform other roles, override C<DOES> appropriately.
+By default, classes in Perl only perform the C<UNIVERSAL> role, as well as the
+role of all classes in their inheritance. In other words, by default C<DOES>
+responds identically to C<isa>.
There is a relationship between roles and classes, as each class implies the
existence of a role of the same name. There is also a relationship between
==== //depot/maint-5.10/perl/lib/lib_pm.PL#2 (text) ====
Index: perl/lib/lib_pm.PL
--- perl/lib/lib_pm.PL#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/lib_pm.PL 2008-05-30 18:54:46.000000000 -0700
@@ -58,7 +58,7 @@
print OUT <<'!NO!SUBS!';
our @ORIG_INC = @INC; # take a handy copy of 'original' value
-our $VERSION = '0.5565';
+our $VERSION = '0.56';
my $Is_MacOS = $^O eq 'MacOS';
my $Mac_FS;
if ($Is_MacOS) {
@@ -79,7 +79,7 @@
$path = _nativize($path);
- if (-e $path && ! -d _) {
+ if ($path !~ /\.par$/i && -e $path && ! -d _) {
require Carp;
Carp::carp("Parameter to use lib must be directory, not file");
}
==== //depot/maint-5.10/perl/lib/strict.t#2 (text) ====
Index: perl/lib/strict.t
--- perl/lib/strict.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/strict.t 2008-05-30 18:54:46.000000000 -0700
@@ -84,17 +84,20 @@
$expected =~ s|(\./)?abc\.pm|:abc.pm|g if $^O eq 'MacOS';
$expected =~ s|./abc|:abc|g if $^O eq 'MacOS';
my $prefix = ($results =~ s/^PREFIX\n//) ;
+ my $TODO = $prog =~ m/^#\s*TODO:/;
if ( $results =~ s/^SKIPPED\n//) {
print "$results\n" ;
}
elsif (($prefix and $results !~ /^\Q$expected/) or
(!$prefix and $results ne $expected)){
- print STDERR "PROG: $switch\n$prog\n";
- print STDERR "EXPECTED:\n$expected\n";
- print STDERR "GOT:\n$results\n";
+ if (! $TODO) {
+ print STDERR "PROG: $switch\n$prog\n";
+ print STDERR "EXPECTED:\n$expected\n";
+ print STDERR "GOT:\n$results\n";
+ }
print "not ";
}
- print "ok " . ++$i . "\n";
+ print "ok " . ++$i . ($TODO ? " # TODO" : "") . "\n";
foreach (@temps)
{ unlink $_ if $_ }
}
==== //depot/maint-5.10/perl/mg.c#13 (text) ====
Index: perl/mg.c
--- perl/mg.c#12~33953~ 2008-05-30 16:12:33.000000000 -0700
+++ perl/mg.c 2008-05-30 18:54:46.000000000 -0700
@@ -1531,7 +1531,7 @@
stash = GvSTASH(
SvTYPE(mg->mg_obj) == SVt_PVGV
? (GV*)mg->mg_obj
- : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+ : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
);
if (stash)
@@ -1555,7 +1555,7 @@
stash = GvSTASH(
SvTYPE(mg->mg_obj) == SVt_PVGV
? (GV*)mg->mg_obj
- : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+ : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
);
if (stash)
==== //depot/maint-5.10/perl/plan9/config_sh.sample#6 (text) ====
Index: perl/plan9/config_sh.sample
--- perl/plan9/config_sh.sample#5~33894~ 2008-05-20 16:39:57.000000000
-0700
+++ perl/plan9/config_sh.sample 2008-05-30 18:54:46.000000000 -0700
@@ -619,6 +619,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='define'
i_ieeefp='undef'
i_inttypes='define'
==== //depot/maint-5.10/perl/pod/perlobj.pod#2 (text) ====
Index: perl/pod/perlobj.pod
--- perl/pod/perlobj.pod#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/pod/perlobj.pod 2008-05-30 18:54:46.000000000 -0700
@@ -407,6 +407,13 @@
C<blessed> returns the name of the package the argument has been
blessed into, or C<undef>.
+=item DOES(ROLE)
+
+C<DOES> returns I<true> if its object claims to perform the role C<ROLE>.
+
+By default, the response to C<DOES> is the same as the response to ISA. For
+more information on C<DOES> and other universal methods, see L<UNIVERSAL>.
+
=item can(METHOD)
X<can>
==== //depot/maint-5.10/perl/pod/perltodo.pod#12 (text) ====
Index: perl/pod/perltodo.pod
--- perl/pod/perltodo.pod#11~33954~ 2008-05-30 17:29:21.000000000 -0700
+++ perl/pod/perltodo.pod 2008-05-30 18:54:46.000000000 -0700
@@ -551,18 +551,6 @@
the perl API that comes from writing modules that use XS to interface to
C.
-=head2 investigate removing int_macro_int from POSIX.xs
-
-As a hang over from the original C<constant> implementation, F<POSIX.xs>
-contains a function C<int_macro_int> which in conjunction with C<AUTOLOAD> is
-used to wrap the C functions C<WEXITSTATUS>, C<WIFEXITED>, C<WIFSIGNALED>,
-C<WIFSTOPPED>, C<WSTOPSIG> and C<WTERMSIG>. It's probably worth replacing
-this complexity with 5 simple direct wrappings of those 5 functions.
-
-However, it would be interesting if someone could measure the memory usage
-before and after, both for the case of C<use POSIX();> and the case of
-actually calling the Perl space functions.
-
=head2 safely supporting POSIX SA_SIGINFO
Some years ago Jarkko supplied patches to provide support for the POSIX
==== //depot/maint-5.10/perl/pp_sort.c#2 (text) ====
Index: perl/pp_sort.c
--- perl/pp_sort.c#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/pp_sort.c 2008-05-30 18:54:46.000000000 -0700
@@ -1553,11 +1553,12 @@
max = AvFILL(av) + 1;
if (SvMAGICAL(av)) {
MEXTEND(SP, max);
- p2 = SP;
for (i=0; i < max; i++) {
SV **svp = av_fetch(av, i, FALSE);
*SP++ = (svp) ? *svp : NULL;
}
+ SP--;
+ p1 = p2 = SP - (max-1);
}
else {
if (SvREADONLY(av))
@@ -1713,7 +1714,7 @@
SvREADONLY_off(av);
else if (av && !sorting_av) {
/* simulate pp_aassign of tied AV */
- SV** const base = ORIGMARK+1;
+ SV** const base = MARK+1;
for (i=0; i < max; i++) {
base[i] = newSVsv(base[i]);
}
==== //depot/maint-5.10/perl/sv.c#19 (text) ====
Index: perl/sv.c
--- perl/sv.c#18~33953~ 2008-05-30 16:12:33.000000000 -0700
+++ perl/sv.c 2008-05-30 18:54:46.000000000 -0700
@@ -246,13 +246,12 @@
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
- sv->sv_debug_line = (U16) (PL_parser
- ? PL_parser->copline == NOLINE
- ? PL_curcop
+ sv->sv_debug_line = (U16) (PL_parser && PL_parser->copline != NOLINE
+ ? PL_parser->copline
+ : PL_curcop
? CopLINE(PL_curcop)
: 0
- : PL_parser->copline
- : 0);
+ );
sv->sv_debug_inpad = 0;
sv->sv_debug_cloned = 0;
sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
==== //depot/maint-5.10/perl/symbian/config.sh#6 (text) ====
Index: perl/symbian/config.sh
--- perl/symbian/config.sh#5~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/symbian/config.sh 2008-05-30 18:54:46.000000000 -0700
@@ -546,6 +546,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
==== //depot/maint-5.10/perl/t/lib/strict/subs#2 (text) ====
Index: perl/t/lib/strict/subs
--- perl/t/lib/strict/subs#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/lib/strict/subs 2008-05-30 18:54:46.000000000 -0700
@@ -393,3 +393,18 @@
EXPECT
Bareword "FOO" not allowed while "strict subs" in use at - line 2.
Execution of - aborted due to compilation errors.
+########
+# [perl #53806] No complain about bareword
+use strict 'subs';
+print FOO . "\n";
+EXPECT
+Bareword "FOO" not allowed while "strict subs" in use at - line 3.
+Execution of - aborted due to compilation errors.
+########
+# [perl #53806] No complain about bareword
+use strict 'subs';
+$ENV{PATH} = "";
+system(FOO . "\n");
+EXPECT
+Bareword "FOO" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
==== //depot/maint-5.10/perl/t/op/index.t#3 (xtext) ====
Index: perl/t/op/index.t
--- perl/t/op/index.t#2~33920~ 2008-05-24 09:04:48.000000000 -0700
+++ perl/t/op/index.t 2008-05-30 18:54:46.000000000 -0700
@@ -7,7 +7,7 @@
}
use strict;
-plan( tests => 69 );
+plan( tests => 111 );
run_tests() unless caller;
@@ -160,4 +160,42 @@
is(index($t, 'xyz'), 4, "0xfffffffd and utf8cache");
}
+
+# Tests for NUL characters.
+{
+ my @tests = (
+ ["", -1, -1, -1],
+ ["foo", -1, -1, -1],
+ ["\0", 0, -1, -1],
+ ["\0\0", 0, 0, -1],
+ ["\0\0\0", 0, 0, 0],
+ ["foo\0", 3, -1, -1],
+ ["foo\0foo\0\0", 3, 7, -1],
+ );
+ foreach my $l (1 .. 3) {
+ my $q = "\0" x $l;
+ my $i = 0;
+ foreach my $test (@tests) {
+ $i ++;
+ my $str = $$test [0];
+ my $res = $$test [$l];
+
+ {
+ is (index ($str, $q), $res, "Find NUL character(s)");
+ }
+
+ #
+ # Bug #53746 shows a difference between variables and literals,
+ # so test literals as well.
+ #
+ my $test_str = qq {is (index ("$str", "$q"), $res, } .
+ qq {"Find NUL character(s)")};
+ $test_str =~ s/\0/\\0/g;
+
+ eval $test_str;
+ die $@ if $@;
+ }
+ }
+}
+
}
==== //depot/maint-5.10/perl/toke.c#8 (text) ====
Index: perl/toke.c
--- perl/toke.c#7~33953~ 2008-05-30 16:12:33.000000000 -0700
+++ perl/toke.c 2008-05-30 18:54:46.000000000 -0700
@@ -5596,10 +5596,10 @@
/* Call it a bare word */
+ bareword:
if (PL_hints & HINT_STRICT_SUBS)
pl_yylval.opval->op_private |= OPpCONST_STRICT;
else {
- bareword:
if (lastchar != '-') {
if (ckWARN(WARN_RESERVED)) {
d = PL_tokenbuf;
==== //depot/maint-5.10/perl/uconfig.sh#7 (xtext) ====
Index: perl/uconfig.sh
--- perl/uconfig.sh#6~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/uconfig.sh 2008-05-30 18:54:46.000000000 -0700
@@ -533,6 +533,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
==== //depot/maint-5.10/perl/util.c#5 (text) ====
Index: perl/util.c
--- perl/util.c#4~33614~ 2008-03-31 09:59:07.000000000 -0700
+++ perl/util.c 2008-05-30 18:54:46.000000000 -0700
@@ -435,9 +435,9 @@
if (little >= lend)
return (char*)big;
{
- char first = *little++;
+ char first = *little;
const char *s, *x;
- bigend -= lend - little;
+ bigend -= lend - little++;
OUTER:
while (big <= bigend) {
if (*big++ == first) {
==== //depot/maint-5.10/perl/win32/config.bc#6 (text) ====
Index: perl/win32/config.bc
--- perl/win32/config.bc#5~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.bc 2008-05-30 18:54:46.000000000 -0700
@@ -613,6 +613,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
==== //depot/maint-5.10/perl/win32/config.ce#6 (text) ====
Index: perl/win32/config.ce
--- perl/win32/config.ce#5~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.ce 2008-05-30 18:54:46.000000000 -0700
@@ -606,6 +606,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
==== //depot/maint-5.10/perl/win32/config.gc#7 (text) ====
Index: perl/win32/config.gc
--- perl/win32/config.gc#6~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.gc 2008-05-30 18:54:46.000000000 -0700
@@ -613,6 +613,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
==== //depot/maint-5.10/perl/win32/config.vc#7 (text) ====
Index: perl/win32/config.vc
--- perl/win32/config.vc#6~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.vc 2008-05-30 18:54:46.000000000 -0700
@@ -613,6 +613,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
==== //depot/maint-5.10/perl/win32/config.vc64#7 (text) ====
Index: perl/win32/config.vc64
--- perl/win32/config.vc64#6~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.vc64 2008-05-30 18:54:46.000000000 -0700
@@ -613,6 +613,8 @@
i_fp='undef'
i_fp_class='undef'
i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
i_grp='undef'
i_ieeefp='undef'
i_inttypes='undef'
End of Patch.
