[perl #118691] Allow defelem magic with neg indices

[perl5.git] / t / op / array.t

diff --git a/t/op/array.t b/t/op/array.t
index 233af19..1064ed7 100644 (file)
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 
-plan (125);
+plan (135);
 
 #
 # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -20,9 +20,6 @@ is($tmp, 5);
 is($#ary, 3);
 is(join('',@ary), '1234');
 
-{
-    no warnings 'deprecated';
-
 @foo = ();
 $r = join(',', $#foo, @foo);
 is($r, "-1");
@@ -55,8 +52,6 @@ $bar[2] = '2';
 $r = join(',', $#bar, @bar);
 is($r, "2,0,,2");
 
-}
-
 $foo = 'now is the time';
 ok(scalar (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)));
 is($F1, 'now');
@@ -449,4 +444,54 @@ $::ra = [ bless [], 'A' ];
 @$::ra = ('a'..'z');
 pass 'no crash when freeing array that is being cleared';
 
+# [perl #85670] Copying magic to elements
+SKIP: {
+    skip "no Scalar::Util::weaken on miniperl", 1, if is_miniperl;
+    require Scalar::Util;
+    package glelp {
+       Scalar::Util::weaken ($a = \@ISA);
+       @ISA = qw(Foo);
+       Scalar::Util::weaken ($a = \$ISA[0]);
+       ::is @ISA, 1, 'backref magic is not copied to elements';
+    }
+}
+package peen {
+    $#ISA = -1;
+    @ISA = qw(Foo);
+    $ISA[0] = qw(Sphare);
+
+    sub Sphare::pling { 'pling' }
+
+    ::is eval { pling peen }, 'pling',
+       'arylen_p magic does not stop isa magic from being copied';
+}
+
+# Test that &PL_sv_undef is not special in arrays
+sub {
+    ok exists $_[0],
+      'exists returns true for &PL_sv_undef elem [perl #7508]';
+    is \$_[0], \undef, 'undef preserves identity in array [perl #109726]';
+}->(undef);
+
+# [perl #118691]
+@plink=@plunk=();
+$plink[3] = 1;
+sub {
+    $_[0] = 2;
+    is $plink[0], 2, '@_ alias to nonexistent elem within array';
+    $_[1] = 3;
+    is $plink[1], 3, '@_ alias to nonexistent neg index within array';
+    is $_[2], undef, 'reading alias to negative index past beginning';
+    eval { $_[2] = 42 };
+    like $@, qr/Modification of non-creatable array value attempted, (?x:
+               )subscript -5/,
+         'error when setting alias to negative index past beginning';
+    is $_[3], undef, 'reading alias to -1 elem of empty array';
+    eval { $_[3] = 42 };
+    like $@, qr/Modification of non-creatable array value attempted, (?x:
+               )subscript -1/,
+         'error when setting alias to -1 elem of empty array';
+}->($plink[0], $plink[-2], $plink[-5], $plunk[-1]);
+
+
 "We're included by lib/Tie/Array/std.t so we need to return something true";