This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don’t let active formats be freed
authorFather Chrysostomos <sprout@cpan.org>
Sun, 5 Aug 2012 19:15:18 +0000 (12:15 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 5 Aug 2012 23:02:16 +0000 (16:02 -0700)
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.

cop.h
t/op/write.t

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 */
index 29b5b8a..6c16191 100644 (file)
@@ -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