Formats in closures called outside closures → crash

If a format closing over lexical variables is defined inside a clo-
sure, it must only be called directly inside that closure, not from
any other eval, sub, or format.

Calling it from anywhere else started causing a crash in 5.10.0,
because the format would try to close over variables in the currently-
running sub, using padoffsets intended for a completely unrelated pad.

This commit stops it from crashing by checking whether the currently-
running sub is a clone of the format’s outer sub (a closure proto-
type).  If it is not, the outer closure prototype is used, resulting
in ‘Variable is not available’ warnings.

This makes things work as well as they did in 5.8.  Ideally, we should
search the call stack for the topmost clone of the format’s outer sub;
but I’m saving that for another commit.
(cherry picked from commit af41786fe5732d5ec7932b946eec99a695ac6e43)

diff --git a/pad.c b/pad.c
index 1075384..4f0cfb8 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1889,11 +1889,16 @@ Perl_cv_clone(pTHX_ CV *proto)
 
     /* Since cloneable anon subs can be nested, CvOUTSIDE may point
      * to a prototype; we instead want the cloned parent who called us.
-     * Note that in general for formats, CvOUTSIDE != find_runcv */
+     * Note that in general for formats, CvOUTSIDE != find_runcv; formats
+     * inside closures, however, only work if CvOUTSIDE == find_runcv.
+     */
 
     outside = CvOUTSIDE(proto);
     if (outside && CvCLONE(outside) && ! CvCLONED(outside))
        outside = find_runcv(NULL);
+    if (SvTYPE(proto) == SVt_PVFM
+     && CvROOT(outside) != CvROOT(CvOUTSIDE(proto)))
+       outside = CvOUTSIDE(proto);
     depth = CvDEPTH(outside);
     assert(depth || SvTYPE(proto) == SVt_PVFM);
     if (!depth)
@@ -1937,11 +1942,10 @@ Perl_cv_clone(pTHX_ CV *proto)
        if (namesv && namesv != &PL_sv_undef) { /* lexical */
            if (SvFAKE(namesv)) {   /* lexical from outside? */
                sv = outpad[PARENT_PAD_INDEX(namesv)];
-               assert(sv);
                /* formats may have an inactive parent,
                   while my $x if $false can leave an active var marked as
                   stale. And state vars are always available */
-               if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
+               if (!sv || (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 dcd8be9..ac106e8 100644 (file)
--- a/t/comp/form_scope.t
+++ b/t/comp/form_scope.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..3\n";
+print "1..5\n";
 
 # Tests bug #22977.  Test case from Dave Mitchell.
 sub f ($);
@@ -50,3 +50,27 @@ sub foo {
 undef *bar;
 write;
 
+# A regression introduced in 5.10; format cloning would close over the
+# variables in the currently-running sub (the main CV in this test) if the
+# outer sub were an inactive closure.
+sub baz {
+  my $a;
+  sub {
+    $a;
+    {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t)}
+    my $x;
+    format STDOUT3 =
+@<<<<<<<<<<<<<<<<<<<<<<<<<
+defined $x ? "not ok 4 - $x" : "ok 4"
+.
+  }
+}
+*STDOUT = *STDOUT3{FORMAT};
+{
+  local $^W = 1;
+  my $w;
+  local $SIG{__WARN__} = sub { $w = shift };
+  write;
+  print "not " unless $w =~ /^Variable "\$x" is not available at/;
+  print "ok 5 - closure var not available when outer sub is inactive\n";
+}