From ee23553f1b79f6259f9464480592b43a0c56e745 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 5 Aug 2012 12:15:18 -0700 Subject: =?UTF-8?q?Don=E2=80=99t=20let=20active=20formats=20be=20freed?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 | 2 ++ t/op/write.t | 13 ++++++++++++- 2 files changed, 14 insertions(+), 1 deletion(-) 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 -- cgit v1.2.1