sv_inc/dec_nomg(): croak on GVs etc

RT #126637

Prior to v5.23.4-100-g20e9643, pp_postinc() etc checked whether the SV was
an AV, non-fake GV, or any other such non-modifiable thinngy; and if so,
called Perl_croak_no_modify(). That commit of mine removed the check, and
instead relied on the underlying sv_inc_nomg() function (called by
pp_postinc()) to do the checking instead. It turns out that while
sv_inc_nomg() etc does some checks, it wasn't as thorough as pp_postinc().
So something like

    my $y = $_++ for *FOO;

now crashes with an assertion failure in sv_inc_nomg() rather than
croaking.

This commit adds such checks to sv_inc_nomg() and sv_dec_nomg() - which
need them anyway, since they may be called from places other than
pp_postinc() etc.

diff --git a/sv.c b/sv.c
index d23cd75..8fad8be 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8773,6 +8773,10 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
        return;
     }
 
+    /* treat AV/HV/CV/FM/IO and non-fake GVs as immutable */
+    if (SvTYPE(sv) >= SVt_PVAV || (isGV_with_GP(sv) && !SvFAKE(sv)))
+        Perl_croak_no_modify();
+
     if (!(flags & SVp_POK) || !*SvPVX_const(sv)) {
        if ((flags & SVTYPEMASK) < SVt_PVIV)
            sv_upgrade(sv, ((flags & SVTYPEMASK) > SVt_IV ? SVt_PVIV : SVt_IV));
@@ -8952,6 +8956,11 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv)
            return;
        }
     }
+
+    /* treat AV/HV/CV/FM/IO and non-fake GVs as immutable */
+    if (SvTYPE(sv) >= SVt_PVAV || (isGV_with_GP(sv) && !SvFAKE(sv)))
+        Perl_croak_no_modify();
+
     if (!(flags & SVp_POK)) {
        if ((flags & SVTYPEMASK) < SVt_PVIV)
            sv_upgrade(sv, ((flags & SVTYPEMASK) > SVt_IV) ? SVt_PVIV : SVt_IV);

diff --git a/t/op/inc.t b/t/op/inc.t
index 517fa2d..492d03e 100644 (file)
--- a/t/op/inc.t
+++ b/t/op/inc.t
@@ -356,4 +356,29 @@ is $store::called, 4, 'STORE called on "my" target';
     is $x, 7, '$lex = $lex++ under use integer';
 }
 
+{
+    # RT #126637 - it should refuse to modify globs
+    *GLOB126637 = [];
+
+    eval 'my $y = ++$_ for *GLOB126637';
+    like $@, qr/Modification of a read-only value/, '++*GLOB126637';
+    eval 'my $y = --$_ for *GLOB126637';
+    like $@, qr/Modification of a read-only value/, '--*GLOB126637';
+    eval 'my $y = $_++ for *GLOB126637';
+    like $@, qr/Modification of a read-only value/, '*GLOB126637++';
+    eval 'my $y = $_-- for *GLOB126637';
+    like $@, qr/Modification of a read-only value/, '*GLOB126637--';
+
+    use integer;
+
+    eval 'my $y = ++$_ for *GLOB126637';
+    like $@, qr/Modification of a read-only value/, 'use int; ++*GLOB126637';
+    eval 'my $y = --$_ for *GLOB126637';
+    like $@, qr/Modification of a read-only value/, 'use int; --*GLOB126637';
+    eval 'my $y = $_++ for *GLOB126637';
+    like $@, qr/Modification of a read-only value/, 'use int; *GLOB126637++';
+    eval 'my $y = $_-- for *GLOB126637';
+    like $@, qr/Modification of a read-only value/, 'use int; *GLOB126637--';
+}
+
 done_testing();