This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Recursive formats and closures in formats.
authorFather Chrysostomos <sprout@cpan.org>
Sun, 5 Aug 2012 08:05:45 +0000 (01:05 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 5 Aug 2012 23:02:01 +0000 (16:02 -0700)
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.

cop.h
pp_sys.c
t/comp/form_scope.t

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 */
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);
index f10637f..4a46796 100644 (file)
@@ -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 =