Change 30070 by [EMAIL PROTECTED] on 2007/01/29 22:12:03
Integrate:
[ 29239]
[perl #40718] perl parser bug leading to memory corruption
quoted-string parser naughtily maintained a pointer into an SV
which could get realloc()ed.
[ 29263]
Fix a bug in the debugger tracing variables when one was eval'ing
a string including a "#line" directive containing the actual
name of the file already. (following-up change #25409)
[ 29273]
Fix bug #39037: rcatline doesn't stringify references
[ 29310]
Subject: [perl #22395] regexp /(.*)[bc]/ 10000 times slower in 5.8.0 vs
5.6.1
From: "yves orton via RT" <[EMAIL PROTECTED]>
Date: Fri, 17 Nov 2006 09:48:14 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 29310]
Subject: [perl #22395] regexp /(.*)[bc]/ 10000 times slower in 5.8.0 vs
5.6.1
From: "yves orton via RT" <[EMAIL PROTECTED]>
Date: Fri, 17 Nov 2006 09:48:14 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 29310]
Subject: [perl #22395] regexp /(.*)[bc]/ 10000 times slower in 5.8.0 vs
5.6.1
From: "yves orton via RT" <[EMAIL PROTECTED]>
Date: Fri, 17 Nov 2006 09:48:14 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 29330]
Unify the two warnings "Can't declare %s in %s", in line with what's
documented in perldiag.
[ 29336]
Invalidate the method lookup cache when assigning to a glob
named "isa". (That happens when importing "isa" from UNIVERSAL,
for example.) Fixes bug #24824.
[ 29350]
Fix infinite loop in Perl_my_strftime() for failing strftime()
Affected files ...
... //depot/maint-5.8/perl/op.c#192 integrate
... //depot/maint-5.8/perl/pp_hot.c#125 integrate
... //depot/maint-5.8/perl/regcomp.c#98 integrate
... //depot/maint-5.8/perl/t/op/attrs.t#5 integrate
... //depot/maint-5.8/perl/t/op/pat.t#36 edit
... //depot/maint-5.8/perl/t/op/readline.t#5 integrate
... //depot/maint-5.8/perl/t/op/universal.t#7 integrate
... //depot/maint-5.8/perl/toke.c#159 integrate
... //depot/maint-5.8/perl/util.c#139 integrate
Differences ...
==== //depot/maint-5.8/perl/op.c#192 (text) ====
Index: perl/op.c
--- perl/op.c#191~30061~ 2007-01-29 09:39:20.000000000 -0800
+++ perl/op.c 2007-01-29 14:12:03.000000000 -0800
@@ -1720,7 +1720,7 @@
type == OP_RV2AV ||
type == OP_RV2HV) { /* XXX does this let anything illegal in? */
if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */
- yyerror(Perl_form(aTHX_ "Can't declare %s in %s",
+ yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",
OP_DESC(o), PL_in_my == KEY_our ? "our" : "my"));
} else if (attrs) {
GV * const gv = cGVOPx_gv(cUNOPo->op_first);
==== //depot/maint-5.8/perl/pp_hot.c#125 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#124~30033~ 2007-01-27 08:40:35.000000000 -0800
+++ perl/pp_hot.c 2007-01-29 14:12:03.000000000 -0800
@@ -130,7 +130,7 @@
assert(SvROK(cv));
}
- /* Can do the optimisation if right (LVAUE) is not a typeglob,
+ /* Can do the optimisation if right (LVALUE) is not a typeglob,
left (RVALUE) is a reference to something, and we're in void
context. */
if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) {
@@ -172,6 +172,10 @@
LEAVE;
}
+ if (strEQ(GvNAME(right),"isa")) {
+ GvCVGEN(right) = 0;
+ ++PL_sub_generation;
+ }
}
SvSetMagicSV(right, left);
SETs(right);
@@ -1617,8 +1621,12 @@
have_fp:
if (gimme == G_SCALAR) {
sv = TARG;
- if (SvROK(sv))
- sv_unref(sv);
+ if (SvROK(sv)) {
+ if (type == OP_RCATLINE)
+ SvPV_force_nolen(sv);
+ else
+ sv_unref(sv);
+ }
(void)SvUPGRADE(sv, SVt_PV);
tmplen = SvLEN(sv); /* remember if already alloced */
if (!tmplen && !SvREADONLY(sv))
==== //depot/maint-5.8/perl/regcomp.c#98 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c#97~30069~ 2007-01-29 13:05:26.000000000 -0800
+++ perl/regcomp.c 2007-01-29 14:12:03.000000000 -0800
@@ -1896,7 +1896,8 @@
first = NEXTOPER(first);
goto again;
}
- else if (!sawopen && (OP(first) == STAR &&
+ else if ((!sawopen || !RExC_sawback) &&
+ (OP(first) == STAR &&
PL_regkind[(U8)OP(NEXTOPER(first))] == REG_ANY) &&
!(r->reganch & ROPT_ANCH) )
{
==== //depot/maint-5.8/perl/t/op/attrs.t#5 (text) ====
Index: perl/t/op/attrs.t
--- perl/t/op/attrs.t#4~26097~ 2005-11-12 08:12:20.000000000 -0800
+++ perl/t/op/attrs.t 2007-01-29 14:12:03.000000000 -0800
@@ -147,9 +147,9 @@
# bug #15898
eval 'our ${""} : foo = 1';
-like $@, qr/Can't declare scalar dereference in our/;
+like $@, qr/Can't declare scalar dereference in "our"/;
eval 'my $$foo : bar = 1';
-like $@, qr/Can't declare scalar dereference in my/;
+like $@, qr/Can't declare scalar dereference in "my"/;
my @code = qw(lvalue locked method);
==== //depot/maint-5.8/perl/t/op/pat.t#36 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t#35~30011~ 2007-01-26 06:31:27.000000000 -0800
+++ perl/t/op/pat.t 2007-01-29 14:12:03.000000000 -0800
@@ -7,7 +7,7 @@
$| = 1;
# please update note at bottom of file when you change this
-print "1..1215\n";
+print "1..1219\n";
BEGIN {
chdir 't' if -d 't';
@@ -3444,5 +3444,35 @@
ok("[EMAIL PROTECTED]" =~ /[EMAIL PROTECTED]/x, 'interpolation of @- in
/@{-}/x');
}
-# last test 1215
+sub iseq($$;$) {
+ my ( $got, $expect, $name)[EMAIL PROTECTED];
+
+ $_=defined($_) ? "'$_'" : "undef"
+ for $got, $expect;
+
+ my $ok= $got eq $expect;
+
+ printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
+ ($name||$Message)."\tLine ".((caller)[2]);
+
+ printf "# Failed test at line %d\n".
+ "# expected: %s\n".
+ "# result: %s\n",
+ (caller)[2], $expect, $got
+ unless $ok;
+
+ $test++;
+ return $ok;
+}
+
+{
+ local $Message="RT#22395";
+ our $count;
+ for my $l (1,10,100,1000) {
+ $count=0;
+ ('a' x $l) =~ /(.*)(?{$count++})[bc]/;
+ iseq($l+1,$count,"Should be L+1 not L*(L+3)/2 (L=$l)");
+ }
+}
+# last test 1219
==== //depot/maint-5.8/perl/t/op/readline.t#5 (text) ====
Index: perl/t/op/readline.t
--- perl/t/op/readline.t#4~29995~ 2007-01-26 01:31:24.000000000 -0800
+++ perl/t/op/readline.t 2007-01-29 14:12:03.000000000 -0800
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 14;
+plan tests => 15;
eval { for (\2) { $_ = <FH> } };
like($@, 'Modification of a read-only value attempted', '[perl #19566]');
@@ -87,8 +87,13 @@
{ switches => ['-w'], stdin => '', stderr => 1 },
'No ARGVOUT used only once warning');
+my $obj = bless [];
+$obj .= <DATA>;
+like($obj, qr/main=ARRAY.*world/, 'rcatline and refs');
+
__DATA__
moo
moo
rules
rules
+world
==== //depot/maint-5.8/perl/t/op/universal.t#7 (xtext) ====
Index: perl/t/op/universal.t
--- perl/t/op/universal.t#6~25564~ 2005-09-22 02:15:24.000000000 -0700
+++ perl/t/op/universal.t 2007-01-29 14:12:03.000000000 -0800
@@ -10,7 +10,7 @@
require "./test.pl";
}
-print "1..102\n";
+print "1..103\n";
$a = {};
bless $a, "Bob";
@@ -189,3 +189,10 @@
my $x = {}; bless $x, 'X';
ok $x->isa('UNIVERSAL');
ok $x->isa('UNIVERSAL');
+
+package Pig;
+package Bodine;
+Bodine->isa('Pig');
+*isa = \&UNIVERSAL::isa;
+eval { isa({}, 'HASH') };
+::is($@, '', "*isa correctly found")
==== //depot/maint-5.8/perl/toke.c#159 (text) ====
Index: perl/toke.c
--- perl/toke.c#158~30061~ 2007-01-29 09:39:20.000000000 -0800
+++ perl/toke.c 2007-01-29 14:12:03.000000000 -0800
@@ -715,12 +715,13 @@
gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
if (gvp) {
gv2 = *(GV**)hv_fetch(PL_defstash, tmpbuf2, tmplen2, TRUE);
- if (!isGV(gv2))
+ if (!isGV(gv2)) {
gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
- /* adjust ${"::_<newfilename"} to store the new file name */
- GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
- GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
- GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+ /* adjust ${"::_<newfilename"} to store the new file name */
+ GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
+ GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
+ GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+ }
}
if (tmpbuf != smallbuf) Safefree(tmpbuf);
if (tmpbuf2 != smallbuf2) Safefree(tmpbuf2);
@@ -10105,7 +10106,7 @@
I32 termcode; /* terminating char. code */
U8 termstr[UTF8_MAXBYTES]; /* terminating string */
STRLEN termlen; /* length of terminating string */
- char *last = NULL; /* last position for nesting bracket */
+ int last_off = 0; /* last position for nesting bracket */
/* skip space before the delimiter */
if (isSPACE(*s)) {
@@ -10187,9 +10188,7 @@
else {
const char *t;
char *w;
- if (!last)
- last = SvPVX(sv);
- for (t = w = last; t < svlast; w++, t++) {
+ for (t = w = SvPVX(sv)+last_off; t < svlast; w++, t++) {
/* At here, all closes are "was quoted" one,
so we don't check PL_multi_close. */
if (*t == '\\') {
@@ -10208,7 +10207,7 @@
*w = '\0';
SvCUR_set(sv, w - SvPVX_const(sv));
}
- last = w;
+ last_off = w - SvPVX(sv);
if (--brackets <= 0)
cont = FALSE;
}
==== //depot/maint-5.8/perl/util.c#139 (text) ====
Index: perl/util.c
--- perl/util.c#138~30069~ 2007-01-29 13:05:26.000000000 -0800
+++ perl/util.c 2007-01-29 14:12:03.000000000 -0800
@@ -4078,7 +4078,7 @@
else {
/* Possibly buf overflowed - try again with a bigger buf */
const int fmtlen = strlen(fmt);
- const int bufsize = fmtlen + buflen;
+ int bufsize = fmtlen + buflen;
Newx(buf, bufsize, char);
while (buf) {
@@ -4091,7 +4091,8 @@
buf = NULL;
break;
}
- Renew(buf, bufsize*2, char);
+ bufsize *= 2;
+ Renew(buf, bufsize, char);
}
return buf;
}
End of Patch.
