Change 28404 broke the construct s/foo/<<BAR/e. So, try to be more

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

diff --git a/t/op/array.t b/t/op/array.t
index 16a3df5..3a6a792 100755 (executable)
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -2,12 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '.', '../lib';
+    @INC = ('.', '../lib');
 }
 
 require 'test.pl';
 
-plan (88);
+plan (117);
 
 #
 # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -61,7 +61,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);
@@ -277,13 +277,111 @@ is ($got, '');
     like($@, qr/Modification of non-creatable array value attempted, subscript -1/, "\$a[-1] = 0");
 }
 
-{
+sub test_arylen {
+    my $ref = shift;
     local $^W = 1;
-    my $a = \$#{[]};
-    is ($$a, undef, "\$# on freed array is undef");
+    is ($$ref, undef, "\$# on freed array is undef");
     my @warn;
     local $SIG{__WARN__} = sub {push @warn, "@_"};
-    $$a = 1000;
+    $$ref = 1000;
     is (scalar @warn, 1);
     like ($warn[0], qr/^Attempt to set length of freed array/);
 }
+
+{
+    my $a = \$#{[]};
+    # Need a new statement to make it go out of scope
+    test_arylen ($a);
+    test_arylen (do {my @a; \$#a});
+}
+
+{
+    use vars '@array';
+
+    my $outer = \$#array;
+    is ($$outer, -1);
+    is (scalar @array, 0);
+
+    $$outer = 3;
+    is ($$outer, 3);
+    is (scalar @array, 4);
+
+    my $ref = \@array;
+
+    my $inner;
+    {
+       local @array;
+       $inner = \$#array;
+
+       is ($$inner, -1);
+       is (scalar @array, 0);
+       $$outer = 6;
+
+       is (scalar @$ref, 7);
+
+       is ($$inner, -1);
+       is (scalar @array, 0);
+
+       $$inner = 42;
+    }
+
+    is (scalar @array, 7);
+    is ($$outer, 6);
+
+    is ($$inner, undef, "orphaned $#foo is always undef");
+
+    is (scalar @array, 7);
+    is ($$outer, 6);
+
+    $$inner = 1;
+
+    is (scalar @array, 7);
+    is ($$outer, 6);
+
+    $$inner = 503; # Bang!
+
+    is (scalar @array, 7);
+    is ($$outer, 6);
+}
+
+{
+    # Bug #36211
+    use vars '@array';
+    for (1,2) {
+       {
+           local @a;
+           is ($#a, -1);
+           @a=(1..4)
+       }
+    }
+}
+
+{
+    # 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);
+}
+
+"We're included by lib/Tie/Array/std.t so we need to return something true";