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
$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);
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";