In perl.git, the branch smoke-me/sprout-maint-5.16 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1fab8097422c9c5cc9be92cd5b4675b764b60545?hp=c4d8885704f2b112d66e7854f620cc3bf4c8ae37>
- Log ----------------------------------------------------------------- commit 1fab8097422c9c5cc9be92cd5b4675b764b60545 Author: Father Chrysostomos <[email protected]> Date: Sat Jun 30 12:43:26 2012 -0700 Cloning a format whose outside has been undefined This has crashed ever since 71f882da8, because the format tries to close over a pad that does not exist: sub x { {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} my $z; format = @<<< $z . } undef &x; write; This commit adds checks for nonexistent pads, producing the âVariable is not availableâ warning in cases like this. (cherry-picked from f2ead8b) ----------------------------------------------------------------------- Summary of changes: pad.c | 12 +++++++----- t/comp/form_scope.t | 22 +++++++++++++++++++++- 2 files changed, 28 insertions(+), 6 deletions(-) diff --git a/pad.c b/pad.c index 4f0cfb8..c70ca08 100644 --- a/pad.c +++ b/pad.c @@ -1903,7 +1903,7 @@ Perl_cv_clone(pTHX_ CV *proto) assert(depth || SvTYPE(proto) == SVt_PVFM); if (!depth) depth = 1; - assert(CvPADLIST(outside)); + assert(CvPADLIST(outside) || SvTYPE(proto) == SVt_PVFM); ENTER; SAVESPTR(PL_compcv); @@ -1934,18 +1934,20 @@ Perl_cv_clone(pTHX_ CV *proto) PL_curpad = AvARRAY(PL_comppad); - outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]); + outpad = CvPADLIST(outside) + ? AvARRAY(AvARRAY(CvPADLIST(outside))[depth]) + : NULL; for (ix = fpad; ix > 0; ix--) { SV* const namesv = (ix <= fname) ? pname[ix] : NULL; SV *sv = NULL; if (namesv && namesv != &PL_sv_undef) { /* lexical */ if (SvFAKE(namesv)) { /* lexical from outside? */ - sv = outpad[PARENT_PAD_INDEX(namesv)]; - /* formats may have an inactive parent, + /* formats may have an inactive, or even undefined, parent, while my $x if $false can leave an active var marked as stale. And state vars are always available */ - if (!sv || (SvPADSTALE(sv) && !SvPAD_STATE(namesv))) { + if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)]) + || (SvPADSTALE(sv) && !SvPAD_STATE(namesv))) { Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE), "Variable \"%"SVf"\" is not available", namesv); sv = NULL; diff --git a/t/comp/form_scope.t b/t/comp/form_scope.t index ac106e8..d4b5edd 100644 --- a/t/comp/form_scope.t +++ b/t/comp/form_scope.t @@ -1,6 +1,6 @@ #!./perl -print "1..5\n"; +print "1..7\n"; # Tests bug #22977. Test case from Dave Mitchell. sub f ($); @@ -74,3 +74,23 @@ defined $x ? "not ok 4 - $x" : "ok 4" print "not " unless $w =~ /^Variable "\$x" is not available at/; print "ok 5 - closure var not available when outer sub is inactive\n"; } + +# Cloning a format whose outside has been undefined +sub x { + {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} + my $z; + format STDOUT6 = +@<<<<<<<<<<<<<<<<<<<<<<<<< +defined $z ? "not ok 6 - $z" : "ok 6" +. +} +undef &x; +*STDOUT = *STDOUT6{FORMAT}; +{ + local $^W = 1; + my $w; + local $SIG{__WARN__} = sub { $w = shift }; + write; + print "not " unless $w =~ /^Variable "\$z" is not available at/; + print "ok 7 - closure var not available when outer sub is undefined\n"; +} -- Perl5 Master Repository
