Recursive formats and closures in formats.

Formats called recursively were using the same set of lexicals, so the
inner call would stomp on the outer calls vars, usually clearing them
when exiting.

Previous commits prepared a CvDEPTH field for formats.  This commit
sets it in P(USH|OP)FORMAT and pushes a new pad in enterwrite.

This also allows closures to work properly in formats.  Formerly they
caused assertion failures in cv_clone.  Now cv_clone’s assumptions
about CvDEPTH on CvOUTSIDE and find_runcv are met when subs are embed-
ded in formats.

diff --git a/cop.h b/cop.h
index 041420c..4cf9fe4 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -627,6 +627,7 @@ struct block_format {
        cx->blk_format.gv = gv;                                         \
        cx->blk_format.retop = (retop);                                 \
        cx->blk_format.dfoutgv = PL_defoutgv;                           \
+       CvDEPTH(cv)++;                                                  \
        SvREFCNT_inc_void(cx->blk_format.dfoutgv)
 
 #define POP_SAVEARRAY()                                                \
@@ -679,6 +680,7 @@ struct block_format {
 
 #define POPFORMAT(cx)                                                  \
        setdefout(cx->blk_format.dfoutgv);                              \
+       CvDEPTH(cx->blk_format.cv)--;                                   \
        SvREFCNT_dec(cx->blk_format.dfoutgv);
 
 /* eval context */

diff --git a/pp_sys.c b/pp_sys.c
index a11eced..cccbff3 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1335,8 +1335,12 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 
     PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
     PUSHFORMAT(cx, retop);
+    if (CvDEPTH(cv) >= 2) {
+       PERL_STACK_OVERFLOW_CHECK();
+       pad_push(CvPADLIST(cv), CvDEPTH(cv));
+    }
     SAVECOMPPAD();
-    PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
+    PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
 
     setdefout(gv);         /* locally select filehandle so $% et al work */
     return CvSTART(cv);

diff --git a/t/comp/form_scope.t b/t/comp/form_scope.t
index f10637f..4a46796 100644 (file)
--- a/t/comp/form_scope.t
+++ b/t/comp/form_scope.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..10\n";
+print "1..13\n";
 
 # Tests bug #22977.  Test case from Dave Mitchell.
 sub f ($);
@@ -118,18 +118,27 @@ undef &x;
   print "ok 9 - closure var not available when outer sub is undefined\n";
 }
 
-format start_subparse::assertion =
-@
-sub { }
+format STDOUT7 =
+@<<<<<<<<<<<<<<<<<<<<<<<<<<<
+do { my $x = "ok 10 - closure inside format"; sub { $x }->() }
 .
-# survived; no "print ok" necessary
+*STDOUT = *STDOUT7{FORMAT};
+write;
+
+$testn = 12;
+format STDOUT8 =
+@<<<< - recursive formats
+do { my $t = "ok " . $testn--; write if $t =~ 12; $t}
+.
+*STDOUT = *STDOUT8{FORMAT};
+write;
 
 # 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 10";
+  my $test = "ok 13";
   *STDOUT = *STDOUT5{FORMAT};
   write;
   format STDOUT5 =