[perl.git] branch blead, updated. v5.25.9-59-ga4031a721e

[Zefram]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/a4031a721e0a1941c14467c7671da2ee1b91c969?hp=bb78386f13c18a1a7dae932b9b36e977056b13c7>

- Log -----------------------------------------------------------------
commit a4031a721e0a1941c14467c7671da2ee1b91c969
Author: Zefram <zef...@fysh.org>
Date:   Sat Jan 28 05:51:00 2017 +0000

    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].
-----------------------------------------------------------------------

Summary of changes:
 sv.c         |  2 ++
 t/op/write.t | 22 +++++++++++++++++++++-
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/sv.c b/sv.c
index bbdca0bf08..339fa1b7d3 100644
--- a/sv.c
+++ b/sv.c
@@ -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

--
Perl5 Master Repository