In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/95c0a761e6d0916fd6abd02af5a344be7de9ecdb?hp=2799b159a376d29e518b47c469185f745cb3c97f>
- Log -----------------------------------------------------------------
commit 95c0a761e6d0916fd6abd02af5a344be7de9ecdb
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sat Sep 10 07:27:43 2016 -0700
pad.c:pad_fixup_inner_anons: Add assertions
These would have made it easier to track down the bug fixed by
the previous commit.
M pad.c
commit 6da13066b6bcab52b33b8891e90130d243b7faa1
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sat Sep 10 07:24:41 2016 -0700
[perl #129090] Crash with sub c{sub c}
The crash in the bug report was caused by v5.21.7-215-g307cbb9, which
added the code in question in order to fix another crash. It exposed
an existing problem caused by v5.21.6-386-ga70f21d.
Some background:
When parsing âsub c{â, perl creates a new CV. The CV gets installed
in the symbol table when the final â}â is reached.
If there is already an undefined CV at that point, it gets reused and
the contents of the new CV are transferred to the existing one. That
means that any subs defined within now have their CvOUTSIDE pointer
pointing to a stub that is about to be freed, so pad_fix_inner_anons
gets called to update those CvOUTSIDE pointers accordingly.
Formats were not getting their CvOUTSIDE pointers updated, so commit
v5.11.2-160-g421f30e added formats to the containing subâs pad to
allow the CvOUTSIDE fix-up to apply to them, too.
That caused a crash, as explained in the commit message for
v5.17.1-213-ge09ac07, that the cited commit fixed by putting a weak RV
in the pad, not a direct pointer to the format, and giving the format
a strong CvOUTSIDE pointer.
Problem:
Commit v5.21.6-386-ga70f21d¹ fixed a problem with named subs not cor-
rectly referencing outer state vars (because of bad CvOUTSIDE point-
ers hiding the lexical vars). It did so by extending the mechanism
already used for formats to apply to named subs as well.
The one mistake that that commit made was to add a pad entry for the
sub even if it was just a stub declaration. That caused a sub with a
stub declaration inside it to a loop if they have the same name:
$ ./perl -Ilib -le '%c; sub c { sub c; eval q|$x| } c'
This happens because the âsub c;â inserts a stub into the symbol table
and inserts a reference to that stub also into the pad of the sub cur-
rently being compiled. The final CvOUTSIDE fix-up sets the CvOUTSIDE
of the erstwhile stub (that has just become the newly defined sub) to
the sub itself. (The %c in the example is necessary to vivify the
typeglob; otherwise perl will cheat and the stub declaration wonât
actually create a CV.)
In addition, a crash can occur in this one-liner (reduced from the
original bug report):
$ ./miniperl -e '$a="a$a";my sub b;%c;sub c{sub b;sub c}'
The fix-up code iterates through the pad backwards, starting from the
last entry, so the CvOUTSIDE(c) -> c loop is set up before the lexical
&b entry is encountered. When it is encountered, CvOUTSIDE pointers
are followed to find the outer pad where b is defined, but the
PARENT_PAD_INDEX stored in the &b padname is wrong for câs own pad,
which is what we end up looking at due to the CvOUTSIDE loop. The
âouterâ entry may then turn out be an RV, not a CV, or just about any-
thing. Crashes ensue.
Another, perhaps clearer, way to make it crash is to give the lexical
sub pad entry an outer offset far beyond the end of the directly-
enclosing sub:
$ ./perl -Ilib -lE '%c; my
($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u); state sub b;
sub c { sub b {} sub c }'
Segmentation fault: 11
Solution:
The fix is to stop package stubs from creating pad entries.
¹ Which I found by bisecting like this, in case anyone is interested:
../perl.git/Porting/bisect.pl --expect-fail --start=v5.20.0
--end=v5.22.0 -e '%c; sub c{sub c}; use B; print
B::svref_2object(\&c)->PADLIST->ARRAYelt(0)->ARRAYelt(1)->PV'
M op.c
M t/op/sub.t
commit bbd6d871a56f710514d051bb71c3909085b11daf
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Sep 8 22:17:34 2016 -0700
op.c: Avoid string cmp when unnecessary
M op.c
commit 9c426bfddbdd904fc37d276cc68e6f2ec04251f4
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Sep 8 14:25:09 2016 -0700
toke.c: Correct comment
M toke.c
-----------------------------------------------------------------------
Summary of changes:
op.c | 4 ++--
pad.c | 2 ++
t/op/sub.t | 14 ++++++++++++++
toke.c | 3 ++-
4 files changed, 20 insertions(+), 3 deletions(-)
diff --git a/op.c b/op.c
index 10a6db1..66cac9b 100644
--- a/op.c
+++ b/op.c
@@ -8686,7 +8686,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP
*attrs,
}
/* don't copy new BEGIN CV to old BEGIN CV - RT #129099 */
- if (name && *name == 'B' && strEQ(name, "BEGIN"))
+ if (name && cv && *name == 'B' && strEQ(name, "BEGIN"))
cv = NULL;
if (cv) { /* must reuse cv if autoloaded */
@@ -8875,7 +8875,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP
*attrs,
if (slab)
Slab_to_ro(slab);
#endif
- if (cv && name && CvOUTSIDE(cv) && !CvEVAL(CvOUTSIDE(cv)))
+ if (cv && name && block && CvOUTSIDE(cv) && !CvEVAL(CvOUTSIDE(cv)))
pad_add_weakref(cv);
}
return cv;
diff --git a/pad.c b/pad.c
index a41d2c7..7cf1fe3 100644
--- a/pad.c
+++ b/pad.c
@@ -2376,6 +2376,7 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV
*old_cv, CV *new_cv)
PADNAME **names = namepad;
PADOFFSET i = ix;
while (PadnameOUTER(name)) {
+ assert(SvTYPE(cv) == SVt_PVCV);
cv = CvOUTSIDE(cv);
names = PadlistNAMESARRAY(CvPADLIST(cv));
i = PARENT_PAD_INDEX(name);
@@ -2406,6 +2407,7 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV
*old_cv, CV *new_cv)
assert(SvWEAKREF(rv));
innercv = (CV *)SvRV(rv);
assert(!CvWEAKOUTSIDE(innercv));
+ assert(CvOUTSIDE(innercv) == old_cv);
SvREFCNT_dec(CvOUTSIDE(innercv));
CvOUTSIDE(innercv) = (CV *)SvREFCNT_inc_simple_NN(new_cv);
}
diff --git a/t/op/sub.t b/t/op/sub.t
index 05fd018..07fa033 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -415,3 +415,17 @@ sub curpm {
}
"a" =~ /(.)/;
is(curpm(), 'c', 'return and PL_curpm');
+
+# [perl #129090] Crashes and hangs
+watchdog 10;
+{ no warnings;
+ eval '$a=qq|a$a|;my sub b;%c;sub c{sub b;sub c}';
+}
+eval '
+ ()= %d;
+ {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u);}
+ {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u);}
+ {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u);}
+ CORE::state sub b; sub d { sub b {} sub d }
+ ';
+eval '()=%e; sub e { sub e; eval q|$x| } e;';
diff --git a/toke.c b/toke.c
index c56b632..5fed84d 100644
--- a/toke.c
+++ b/toke.c
@@ -9812,7 +9812,8 @@ S_scan_heredoc(pTHX_ char *s)
/* scan_inputsymbol
takes: position of first '<' in input buffer
- returns: position of first char following the last '>' in input buffer
+ returns: position of first char following the matching '>' in
+ input buffer
side-effects: pl_yylval and lex_op are set.
This code handles:
--
Perl5 Master Repository
