diff options
| author | Zefram <zefram@fysh.org> | 2017-01-28 05:51:00 +0000 |
|---|---|---|
| committer | Zefram <zefram@fysh.org> | 2017-01-28 05:52:08 +0000 |
| commit | a4031a721e0a1941c14467c7671da2ee1b91c969 (patch) | |
| tree | fe1a96a32464472b97c7549702d9fa34610c6839 | |
| parent | bb78386f13c18a1a7dae932b9b36e977056b13c7 (diff) | |
| download | perl-a4031a721e0a1941c14467c7671da2ee1b91c969.tar.gz | |
croak on sv_setpvn() on a glob
A real glob cannot be written to as a string scalar, and a sv_setpvn()
call attempting to do so used to hit an assertion. (sv_force_normal()
coerces glob copies to strings, but leaves real globs unchanged.)
This isn't exposed through assignment ops, which have special semantics
for assignments to globs, but it can be reached through XS subs that
mutate arguments, and through "^" formats. Change sv_setpvn() to check
for globs and croak cleanly. Fixes [perl #129147].
| -rw-r--r-- | sv.c | 2 | ||||
| -rw-r--r-- | t/op/write.t | 22 |
2 files changed, 23 insertions, 1 deletions
@@ -4985,6 +4985,8 @@ Perl_sv_setpvn(pTHX_ SV *const sv, const char *const ptr, const STRLEN len) PERL_ARGS_ASSERT_SV_SETPVN; SV_CHECK_THINKFIRST_COW_DROP(sv); + if (isGV_with_GP(sv)) + Perl_croak_no_modify(); if (!ptr) { (void)SvOK_off(sv); return; diff --git a/t/op/write.t b/t/op/write.t index 31726812ba..d41e854c8a 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 + 6 + 2 + 3 + 96 + 11 + 4; +my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 12; # number of tests in section 4 my $hmb_tests = 37; @@ -2001,6 +2001,26 @@ EOP { stderr => 1 }, '#128255 Assert fail in S_sublex_done'); +{ + $^A = ""; + my $a = *globcopy; + my $r = eval { formline "^<<", $a }; + is $@, ""; + ok $r, "^ format with glob copy"; + is $^A, "*ma", "^ format with glob copy"; + is $a, "in::globcopy", "^ format with glob copy"; +} + +{ + $^A = ""; + my $r = eval { formline "^<<", *realglob }; + like $@, qr/\AModification of a read-only value attempted /; + is $r, undef, "^ format with real glob"; + is $^A, "*ma", "^ format with real glob"; + is ref(\*realglob), "GLOB"; +} + +$^A = ""; ############################# ## Section 4 |