In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/3275d25a1e4129bdf23c447f60be4348af4dfe19?hp=a55c21fc5cb5464e6c8e268297570cb845eb2142>
- Log -----------------------------------------------------------------
commit 3275d25a1e4129bdf23c447f60be4348af4dfe19
Author: Aaron Crane <a...@cpan.org>
Date: Thu Mar 16 12:33:59 2017 +0000
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.
-----------------------------------------------------------------------
Summary of changes:
pp.c | 3 +++
t/op/push.t | 15 ++++++++++++++-
t/op/splice.t | 10 ++++++++++
t/op/unshift.t | 11 ++++++++++-
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";
+}
--
Perl5 Master Repository
