Don't SEGV while warning about redefining the format STDOUT. Fixes RT #64562.
authorNicholas Clark <nick@ccl4.org>
Thu, 9 Apr 2009 18:25:37 +0000 (19:25 +0100)
committerDavid Mitchell <davem@iabyn.com>
Mon, 20 Apr 2009 00:53:46 +0000 (01:53 +0100)
(cherry picked from commit ee6d2783b2d78accfac54397826acf5f6e1715e1)

op.c
t/op/write.t

diff --git a/op.c b/op.c
index 3916137..246c843 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6116,9 +6116,13 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
            const line_t oldline = CopLINE(PL_curcop);
            if (PL_parser && PL_parser->copline != NOLINE)
                CopLINE_set(PL_curcop, PL_parser->copline);
-           Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                       o ? "Format %"SVf" redefined"
-                       : "Format STDOUT redefined", SVfARG(cSVOPo->op_sv));
+           if (o) {
+               Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+                           "Format %"SVf" redefined", SVfARG(cSVOPo->op_sv));
+           } else {
+               Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+                           "Format STDOUT redefined");
+           }
            CopLINE_set(PL_curcop, oldline);
        }
        SvREFCNT_dec(cv);
index 429936c..07b5f73 100755 (executable)
@@ -61,7 +61,7 @@ for my $tref ( @NumTests ){
 my $bas_tests = 20;
 
 # number of tests in section 3
-my $bug_tests = 4 + 3 * 3 * 5 * 2 * 3 + 2;
+my $bug_tests = 4 + 3 * 3 * 5 * 2 * 3 + 2 + 1;
 
 # number of tests in section 4
 my $hmb_tests = 35;
@@ -607,6 +607,23 @@ $= = 10;
 select $oldfh;
 close STDOUT_DUP;
 
+fresh_perl_like(<<'EOP', qr/^Format STDOUT redefined at/, {stderr => 1}, '#64562 - Segmentation fault with redefined formats and warnings');
+#!./perl
+
+use strict;
+use warnings; # crashes!
+
+format =
+.
+
+write;
+
+format =
+.
+
+write;
+EOP
+
 #############################
 ## Section 4
 ## Add new tests *above* here