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.

diff --git a/cop.h b/cop.h
index 4cf9fe4..ed55483 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;                           \
+       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 29b5b8a..6c16191 100644 (file)
--- 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