RT#131000: splice doesn't honour read-only flag

The push and unshift builtins were correctly throwing a "Modification of a
read-only value attempted" exception when modifying a read-only array, but
splice was silently modifying the array. This commit adds tests that all
three builtins throw such an exception.

One discrepancy between the three remains: push has long silently accepted
a push of no elements onto an array, whereas unshift throws an exception in
that situation. This seems to have been originally a coincidence. The
pp_unshift implementation first makes space for the elements it unshifts
(which croaks for a read-only array), then copies the new values into the
space thus created. The pp_push implementation, on the other hand, calls
av_push() individually on each element; that implicitly croaks, but only one
there's at least one element being pushed.

The pp_push implementation has subsequently been changed: read-only checking
is now done first, but that was done to fix a memory leak. (If the av_push()
itself failed, then the new SV that had been allocated for pushing onto the
array would get leaked.) That leak fix specifically grandfathered in the
acceptance of empty-push-to-readonly-array, to avoid changing behaviour.

I'm not fond of the inconsistency betwen push on the one hand and unshift &
splice on the other, but I'm disinclined to make empty-push-to-readonly
suddenly start throwing an exception after all these years, and it seems
best not to extend that exemption-from-exception to the other builtins.

4 files changed, 37 insertions, 2 deletions

diff --git a/pp.c b/pp.c
index 822b6945b8..b55e81b705 100644
--- a/pp.c
+++ b/pp.c
@@ -5249,6 +5249,9 @@ PP(pp_splice)
 				    sp - mark);
     }
 
+    if (SvREADONLY(ary))
+        Perl_croak_no_modify();
+
     SP++;
 
     if (++MARK < SP) {
diff --git a/t/op/push.t b/t/op/push.t
index c94c91953f..2394f74800 100644
--- a/t/op/push.t
+++ b/t/op/push.t
@@ -20,7 +20,7 @@ BEGIN {
 -4,			4 5 6 7,	0 1 2 3
 EOF
 
-plan tests => 8 + @tests*2;
+plan tests => 10 + @tests*2;
 die "blech" unless @tests;
 
 @x = (1,2,3);
@@ -71,4 +71,17 @@ foreach $line (@tests) {
     is(join(':',@x),   join(':',@leave), "left: @x == @leave");
 }
 
+# See RT#131000
+{
+    local $@;
+    my @readonly_array = 10..11;
+    Internals::SvREADONLY(@readonly_array, 1);
+    eval { push @readonly_array, () };
+    is $@, '', "can push empty list onto readonly array";
+
+    eval { push @readonly_array, 9 };
+    like $@, qr/^Modification of a read-only value/,
+        "croak when pushing onto readonly array";
+}
+
 1;  # this file is require'd by lib/tie-stdpush.t
diff --git a/t/op/splice.t b/t/op/splice.t
index 7ad49db2ba..c786802354 100644
--- a/t/op/splice.t
+++ b/t/op/splice.t
@@ -98,4 +98,14 @@ $#a++;
 is sprintf("%s", splice @a, 0, 1, undef), "",
   'splice handles nonexistent elems when array len stays the same';
 
+# RT#131000
+{
+    local $@;
+    my @readonly_array = 10..11;
+    Internals::SvREADONLY(@readonly_array, 1);
+    eval { splice @readonly_array, 1, 0, () };
+    like $@, qr/^Modification of a read-only value/,
+        "croak when splicing into readonly array";
+}
+
 done_testing;
diff --git a/t/op/unshift.t b/t/op/unshift.t
index 66fd0ff86a..094f6b9900 100644
--- a/t/op/unshift.t
+++ b/t/op/unshift.t
@@ -5,7 +5,7 @@ BEGIN {
     require "./test.pl";
 }
 
-plan(18);
+plan(19);
 
 @array = (1, 2, 3);
 
@@ -68,3 +68,12 @@ is(join(' ',@alpha), 's t u v w x y z', 'void unshift array');
 unshift (@alpha, @bet, @gimel);
 is(join(' ',@alpha), 'q r s t u v w x y z', 'void unshift arrays');
 
+# See RT#131000
+{
+    local $@;
+    my @readonly_array = 10..11;
+    Internals::SvREADONLY(@readonly_array, 1);
+    eval { unshift @readonly_array, () };
+    like $@, qr/^Modification of a read-only value/,
+        "croak when unshifting onto readonly array";
+}