In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/fb9282c3ccd3b3c2e184a3158c46c930c23f30fb?hp=4c0ef2088519deeee7642c58f661b5d8a70ccf2f>
- Log ----------------------------------------------------------------- commit fb9282c3ccd3b3c2e184a3158c46c930c23f30fb Author: Tony Cook <[email protected]> Date: Wed Dec 10 11:54:49 2014 +1100 [perl #123245] avoid a panic in sv_chop() in formats This fixes two issues: 1) if you don't supply enough arguments to the format, pp_formline() uses &PL_sv_no as the sv, since we've already warned about the missing format argument, we don't need to produce a read only error for an SV the caller didn't supply 2) when the supplied string is empty for FF_LINESNGL and FF_LINEGLOB the case would skip most of its processing, including setting chophere, this meant that when the following FF_CHOP operator was processed it would pass a pointer into a different string, producing a panic. M pp_ctl.c M t/op/write.t commit fcaef4dc8ca94ff0fe27bf4a249a5583ca0e7af5 Author: Tony Cook <[email protected]> Date: Wed Dec 10 11:51:39 2014 +1100 [perl #123245] tests for format crashes M t/op/write.t ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 4 ++-- t/op/write.t | 26 +++++++++++++++++++++++++- 2 files changed, 27 insertions(+), 3 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index d188473..0bbc626 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -674,7 +674,7 @@ PP(pp_formline) goto append; case FF_CHOP: /* (for ^*) chop the current item */ - { + if (sv != &PL_sv_no) { const char *s = chophere; if (chopspace) { while (isSPACE(*s)) @@ -701,11 +701,11 @@ PP(pp_formline) const char *const send = s + len; item_is_utf8 = DO_UTF8(sv); + chophere = s + len; if (!len) break; trans = 0; gotsome = TRUE; - chophere = s + len; source = (U8 *) s; to_copy = len; while (s < send) { diff --git a/t/op/write.t b/t/op/write.t index 653561f..4b13057 100644 --- a/t/op/write.t +++ b/t/op/write.t @@ -98,7 +98,7 @@ for my $tref ( @NumTests ){ my $bas_tests = 21; # number of tests in section 3 -my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11; +my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11 + 2; # number of tests in section 4 my $hmb_tests = 37; @@ -1935,6 +1935,30 @@ format Potshriggley = is $x, undef, 'formats in subs do not leak'; } +fresh_perl_is(<<'EOP', <<'EXPECT', +use warnings 'syntax' ; +format STDOUT = +^*|^* +my $x = q/dd/, $x +. +write; +EOP +dd| +EXPECT + { stderr => 1 }, '#123245 panic in sv_chop'); + +fresh_perl_is(<<'EOP', <<'EXPECT', +use warnings 'syntax' ; +format STDOUT = +^*|^* +my $x = q/dd/ +. +write; +EOP +Not enough format arguments at - line 4. +dd| +EXPECT + { stderr => 1 }, '#123245 different panic in sv_chop'); ############################# ## Section 4 -- Perl5 Master Repository
