Don’t let active formats be freed

This crashes:

format FOO =
@<
undef *FOO
.
$~ = FOO;
write

The context stack needs to hold a reference count for formats, just as
it does for subs.

2 files changed, 14 insertions, 1 deletions

diff --git a/cop.h b/cop.h
index 4cf9fe4027..ed55483a94 100644
--- 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;				\
+	if (!CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv);		\
 	CvDEPTH(cv)++;							\
 	SvREFCNT_inc_void(cx->blk_format.dfoutgv)
 
@@ -681,6 +682,7 @@ struct block_format {
 #define POPFORMAT(cx)							\
 	setdefout(cx->blk_format.dfoutgv);				\
 	CvDEPTH(cx->blk_format.cv)--;					\
+	if (!CvDEPTH(cx->blk_format.cv)) SvREFCNT_dec(cx->blk_format.cv); \
 	SvREFCNT_dec(cx->blk_format.dfoutgv);
 
 /* eval context */
diff --git a/t/op/write.t b/t/op/write.t
index 29b5b8a310..6c16191878 100644
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -61,7 +61,7 @@ for my $tref ( @NumTests ){
 my $bas_tests = 20;
 
 # number of tests in section 3
-my $bug_tests = 8 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96;
+my $bug_tests = 8 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 1;
 
 # number of tests in section 4
 my $hmb_tests = 35;
@@ -984,6 +984,17 @@ return
     close RT73690_2 or die "Could not close: $!";
 })[0];
 
+open(UNDEF, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+select +(select(UNDEF), $~ = "UNDEFFORMAT")[0];
+format UNDEFFORMAT =
+@
+undef *UNDEFFORMAT
+.
+write UNDEF;
+pass "active format cannot be freed";
+close UNDEF or die "Could not close: $!";
+
+
 #############################
 ## Section 4
 ## Add new tests *above* here