This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don’t crash when undefining handle of active format
authorFather Chrysostomos <sprout@cpan.org>
Sun, 5 Aug 2012 20:13:12 +0000 (13:13 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 5 Aug 2012 23:02:17 +0000 (16:02 -0700)
format FOO =
@
undef *STDOUT
.
$~ = FOO;
write

Commit 7ef822cddfe9 began the work by putting in a null check and a
goto (to bypass the top format), but the goto wentto some code that
lacked the null check.  (It did actually fix the case of a IO with no
ofp, but not the case of a GV with no IO.)  Interestingly, it added a
bad_ofp label, but did not add the code to goto it (an oversight?).

The unused bad_ofp label was commented out in commit 9cbac4c72b52.

There was already a check before 7ef822cddfe9 to see whether there was
an ofp, but only after the format scope has been popped.

This commit extends that check by making sure there is an io first.

It removes the commented-out bad_ofp label.

pp_sys.c
t/op/write.t

index cccbff3..85fa251 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1477,9 +1477,8 @@ PP(pp_leavewrite)
     SP = newsp; /* ignore retval of formline */
     LEAVE;
 
-    fp = IoOFP(io);
-    if (!fp) {
-       if (IoIFP(io))
+    if (!io || !(fp = IoOFP(io))) {
+       if (io && IoIFP(io))
            report_wrongway_fh(gv, '<');
        else
            report_evil_fh(gv);
@@ -1500,7 +1499,6 @@ PP(pp_leavewrite)
            PUSHs(&PL_sv_yes);
        }
     }
-    /* bad_ofp: */
     PL_formtarget = PL_bodytarget;
     PERL_UNUSED_VAR(gimme);
     RETURNOP(retop);
index 6c16191..a648902 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 + 1;
+my $bug_tests = 8 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 2;
 
 # number of tests in section 4
 my $hmb_tests = 35;
@@ -992,7 +992,15 @@ undef *UNDEFFORMAT
 .
 write UNDEF;
 pass "active format cannot be freed";
-close UNDEF or die "Could not close: $!";
+
+select +(select(UNDEF), $~ = "UNDEFFORMAT2")[0];
+format UNDEFFORMAT2 =
+@
+close UNDEF or die "Could not close: $!"; undef *UNDEF
+.
+write UNDEF;
+pass "freeing current handle in format";
+undef $^A;
 
 
 #############################