In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f2ead8b816519a65496980beeb8606954f270d43?hp=5578394101efd4d95c058c4f22f51763ae92ebc2>
- Log ----------------------------------------------------------------- commit f2ead8b816519a65496980beeb8606954f270d43 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. ----------------------------------------------------------------------- Summary of changes: pad.c | 12 +++++++----- t/comp/form_scope.t | 24 ++++++++++++++++++++++-- 2 files changed, 29 insertions(+), 7 deletions(-) diff --git a/pad.c b/pad.c index c569e18..032f8f5 100644 --- a/pad.c +++ b/pad.c @@ -1946,7 +1946,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); @@ -1981,18 +1981,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 6344652..809e0d2 100644 --- a/t/comp/form_scope.t +++ b/t/comp/form_scope.t @@ -1,6 +1,6 @@ #!./perl -print "1..8\n"; +print "1..10\n"; # Tests bug #22977. Test case from Dave Mitchell. sub f ($); @@ -98,12 +98,32 @@ $next = $clo1; $next = $clo2; &$clo1(0); +# 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 8 - $z" : "ok 8" +. +} +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 9 - closure var not available when outer sub is undefined\n"; +} + # This is a variation of bug #22977, which crashes or fails an assertion # up to 5.16. # Keep this test last if you want test numbers to be sane. BEGIN { \&END } END { - my $test = "ok 8"; + my $test = "ok 10"; *STDOUT = *STDOUT5{FORMAT}; write; format STDOUT5 = -- Perl5 Master Repository
