Don’t let formats outlive their outer subs

This began crashing in 5.11.3:

sub foo {
  sub bar {
    my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$x);
    format =
@||||||
$x
.
  }
}
undef *bar;
write;

(On some systems, you need more alphabet soup to make it crash.)

This commit (just the perly.y part shown) caused it to crash:

commit 421f30ed1e95009450bdc7905bf3433ee806ea4f
Author: Zefram <zefram@fysh.org>
Date:   Tue Dec 15 11:48:31 2009 +0100

    [perl #22977] Bug in format/write

diff --git a/perly.y b/perly.y
index 18e5875..a61a6b3 100644
--- a/perly.y
+++ b/perly.y
@@ -511,7 +511,9 @@ peg	:	PEG
 	;

 format	:	FORMAT startformsub formname block
-			{ SvREFCNT_inc_simple_void(PL_compcv);
+			{
+			  CV *fmtcv = PL_compcv;
+			  SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
 			  $$ = newFORM($2, $3, $4);
 			  prepend_madprops($1->tk_mad, $$, 'F');
@@ -521,6 +523,10 @@ format	:	FORMAT startformsub formname block
 			  newFORM($2, $3, $4);
 			  $$ = (OP*)NULL;
 #endif
+			  if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) {
+			    SvREFCNT_inc_simple_void(fmtcv);
+			    pad_add_anon((SV*)fmtcv, OP_NULL);
+			  }
 			}
 	;

Unfortunately, adding the format to the pad like that (to allow
pad_fixup_inner_anons to fix up formats as well as subs) is proble-
matic.  It causes the format’s CvOUTSIDE to be weak.  Since the for-
mat does not hold a reference count on its outer sub, that sub can be
freed before the format.  When that happens, regular subs are fixed
up by having CvOUTSIDE change to point to the grandparent.  If you
do that for formats, you run into a problem: Formats can be cloned
even when the outer sub is not running.  Formats are cloned whenever
invoked *by name* via write.  If CvOUTSIDE points to a different sub,
then closing over the scalars in specific pad offsets in that sub can
result in reading past the end of the pad.  If you don’t read past the
end of the pad, you are still making variables close over unrelated variables, so the inner $x could close over an outer @y, etc.  Subrou-
tines don’t have that problem, as they can only be cloned when they
have an outer sub.  (Even though the outer sub’s prototype, if it is a
closure, might have been freed, the outer sub itself is still running
and referenced by the context stack.)

This commit changes the direction of the weak reference between an
outer sub’s pad and an inner format, fixing the crash.

To do so, it has to store, not the format itself, but a weak RV point-
ing to the format, in the outer sub’s pad.

1 files changed, 23 insertions, 2 deletions

diff --git a/pad.c b/pad.c
index 56c9ed9211..66593f2095 100644
--- a/pad.c
+++ b/pad.c
@@ -400,6 +400,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 			CV * const innercv = MUTABLE_CV(curpad[ix]);
 			U32 inner_rc = SvREFCNT(innercv);
 			assert(inner_rc);
+			assert(SvTYPE(innercv) != SVt_PVFM);
 			namepad[ix] = NULL;
 			SvREFCNT_dec(namesv);
 
@@ -744,12 +745,19 @@ Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
     ix = pad_alloc(optype, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */
-    av_store(PL_comppad, ix, (SV*)func);
+    if (SvTYPE(func) == SVt_PVCV || !CvOUTSIDE(func))
+	av_store(PL_comppad, ix, (SV*)func);
+    else {
+	SV *rv = newRV_inc((SV *)func);
+	sv_rvweaken(rv);
+	assert (SvTYPE(func) == SVt_PVFM);
+	av_store(PL_comppad, ix, rv);
+    }
     SvPADMY_on((SV*)func);
 
     /* to avoid ref loops, we never have parent + child referencing each
      * other simultaneously */
-    if (CvOUTSIDE(func)) {
+    if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
 	assert(!CvWEAKOUTSIDE(func));
 	CvWEAKOUTSIDE_on(func);
 	SvREFCNT_dec(CvOUTSIDE(func));
@@ -2022,10 +2030,23 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 	if (namesv && namesv != &PL_sv_undef
 	    && *SvPVX_const(namesv) == '&')
 	{
+	  if (SvTYPE(curpad[ix]) == SVt_PVCV) {
 	    CV * const innercv = MUTABLE_CV(curpad[ix]);
 	    assert(CvWEAKOUTSIDE(innercv));
 	    assert(CvOUTSIDE(innercv) == old_cv);
 	    CvOUTSIDE(innercv) = new_cv;
+	  }
+	  else { /* format reference */
+	    SV * const rv = curpad[ix];
+	    CV *innercv;
+	    if (!SvOK(rv)) continue;
+	    assert(SvROK(rv));
+	    assert(SvWEAKREF(rv));
+	    innercv = (CV *)SvRV(rv);
+	    assert(!CvWEAKOUTSIDE(innercv));
+	    SvREFCNT_dec(CvOUTSIDE(innercv));
+	    CvOUTSIDE(innercv) = (CV *)SvREFCNT_inc_simple_NN(new_cv);
+	  }
 	}
     }
 }