localisation of $[ is deprecated, so needs no warnings 'deprecated';

[p5sagit/p5-mst-13.2.git] / t / op / array.t

diff --git a/t/op/array.t b/t/op/array.t
old mode 100755 (executable)
new mode 100644 (file)
index 6461a43..0027f4b
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -7,7 +7,7 @@ BEGIN {
 
 require 'test.pl';
 
-plan (111);
+plan (125);
 
 #
 # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -21,6 +21,9 @@ is($tmp, 5);
 is($#ary, 3);
 is(join('',@ary), '1234');
 
+{
+    no warnings 'deprecated';
+
 $[ = 1;
 @ary = (1,2,3,4,5);
 is(join('',@ary), '12345');
@@ -61,7 +64,7 @@ is($r, "0,0");
 $bar[2] = '2';
 $r = join(',', $#bar, @bar);
 is($r, "2,0,,2");
-reset 'b';
+reset 'b' if $^O ne 'VMS';
 @bar = ();
 $bar[0] = '0';
 $r = join(',', $#bar, @bar);
@@ -70,6 +73,8 @@ $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');
@@ -119,7 +124,10 @@ $foo = ('a','b','c','d','e','f')[1];
 is($foo, 'b');
 
 @foo = ( 'foo', 'bar', 'burbl');
-push(foo, 'blah');
+{
+    no warnings 'deprecated';
+    push(foo, 'blah');
+}
 is($#foo, 3);
 
 # various AASSIGN_COMMON checks (see newASSIGNOP() in op.c)
@@ -176,7 +184,6 @@ is("@bar", "foo bar");                                              # 43
 
 # try the same with my
 {
-
     my @bee = @bee;
     is("@bee", "foo bar burbl blah");                          # 54
     {
@@ -202,6 +209,29 @@ is("@bar", "foo bar");                                             # 43
     is("@bee", "foo bar burbl blah");                          # 63
 }
 
+# try the same with our (except that previous values aren't restored)
+{
+    our @bee = @bee;
+    is("@bee", "foo bar burbl blah");
+    {
+       our (undef,@bee) = @bee;
+       is("@bee", "bar burbl blah");
+       {
+           our @bee = ('XXX',@bee,'YYY');
+           is("@bee", "XXX bar burbl blah YYY");
+           {
+               our @bee = our @bee = qw(foo bar burbl blah);
+               is("@bee", "foo bar burbl blah");
+               {
+                   our (@bim) = our(@bee) = qw(foo bar);
+                   is("@bee", "foo bar");
+                   is("@bim", "foo bar");
+               }
+           }
+       }
+    }
+}
+
 # make sure reification behaves
 my $t = curr_test();
 sub reify { $_[1] = $t++; print "@_\n"; }
@@ -230,6 +260,7 @@ is ($foo[1], "a");
 
 
 sub tary {
+  no warnings 'deprecated';
   local $[ = 10;
   my $five = 5;
   is ($tary[5], $tary[$five]);
@@ -356,4 +387,46 @@ sub test_arylen {
     }
 }
 
+{
+    # Bug #37350
+    my @array = (1..4);
+    $#{@array} = 7;
+    is ($#{4}, 7);
+
+    my $x;
+    $#{$x} = 3;
+    is(scalar @$x, 4);
+
+    push @{@array}, 23;
+    is ($4[8], 23);
+}
+{
+    # Bug #37350 -- once more with a global
+    use vars '@array';
+    @array = (1..4);
+    $#{@array} = 7;
+    is ($#{4}, 7);
+
+    my $x;
+    $#{$x} = 3;
+    is(scalar @$x, 4);
+
+    push @{@array}, 23;
+    is ($4[8], 23);
+}
+
+# more tests for AASSIGN_COMMON
+
+{
+    our($x,$y,$z) = (1..3);
+    our($y,$z) = ($x,$y);
+    is("$x $y $z", "1 1 2");
+}
+{
+    our($x,$y,$z) = (1..3);
+    (our $y, our $z) = ($x,$y);
+    is("$x $y $z", "1 1 2");
+}
+
+
 "We're included by lib/Tie/Array/std.t so we need to return something true";