diff options
| -rw-r--r-- | cop.h | 2 | ||||
| -rw-r--r-- | pp_sys.c | 6 | ||||
| -rw-r--r-- | t/comp/form_scope.t | 21 |
3 files changed, 22 insertions, 7 deletions
@@ -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 */ @@ -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 f10637fd54..4a46796fb2 100644 --- 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 = |