5 @INC = ('.', '../lib');
13 # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
17 is(join('',@ary), '12345');
19 $tmp = $ary[$#ary]; --$#ary;
22 is(join('',@ary), '1234');
25 no warnings 'deprecated';
29 is(join('',@ary), '12345');
31 $tmp = $ary[$#ary]; --$#ary;
33 # Must do == here beacuse $[ isn't 0
35 is(join('',@ary), '1234');
39 $#ary += 1; # see if element 5 gone for good
45 $r = join(',', $#foo, @foo);
48 $r = join(',', $#foo, @foo);
51 $r = join(',', $#foo, @foo);
56 $r = join(',', $#bar, @bar);
59 $r = join(',', $#bar, @bar);
62 $r = join(',', $#bar, @bar);
65 $r = join(',', $#bar, @bar);
67 reset 'b' if $^O ne 'VMS';
70 $r = join(',', $#bar, @bar);
73 $r = join(',', $#bar, @bar);
78 $foo = 'now is the time';
79 ok(scalar (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)));
85 ok(!($cnt = (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/))))
86 or diag("$cnt $F1:$F2:$Etc");
88 %foo = ('blurfl','dyick','foo','bar','etc.','etc.');
90 is($bar{'foo'}, 'bar');
92 is($bar{'foo'}, undef);
93 (%bar,$a,$b) = (%foo,'how','now');
94 is($bar{'foo'}, 'bar');
95 is($bar{'how'}, 'now');
96 @bar{keys %foo} = values %foo;
97 is($bar{'foo'}, 'bar');
98 is($bar{'how'}, 'now');
100 @foo = grep(/e/,split(' ','now is the time for all good men to come to'));
101 is(join(' ',@foo), 'the time men come');
103 @foo = grep(!/e/,split(' ','now is the time for all good men to come to'));
104 is(join(' ',@foo), 'now is for all good to to');
106 $foo = join('',('a','b','c','d','e','f')[0..5]);
109 $foo = join('',('a','b','c','d','e','f')[0..1]);
112 $foo = join('',('a','b','c','d','e','f')[6]);
115 @foo = ('a','b','c','d','e','f')[0,2,4];
116 @bar = ('a','b','c','d','e','f')[1,3,5];
117 $foo = join('',(@foo,@bar)[0..5]);
120 $foo = ('a','b','c','d','e','f')[0,2,4];
123 $foo = ('a','b','c','d','e','f')[1];
126 @foo = ( 'foo', 'bar', 'burbl');
128 no warnings 'deprecated';
133 # various AASSIGN_COMMON checks (see newASSIGNOP() in op.c)
138 is("@foo", "foo bar burbl blah"); # 38
141 is("@foo", "bar burbl blah"); # 39
143 @foo = ('XXX',@foo, 'YYY');
144 is("@foo", "XXX bar burbl blah YYY"); # 40
146 @foo = @foo = qw(foo b\a\r bu\\rbl blah);
147 is("@foo", 'foo b\a\r bu\\rbl blah'); # 41
149 @bar = @foo = qw(foo bar); # 42
150 is("@foo", "foo bar");
151 is("@bar", "foo bar"); # 43
153 # try the same with local
154 # XXX tie-stdarray fails the tests involving local, so we use
155 # different variable names to escape the 'tie'
157 @bee = ( 'foo', 'bar', 'burbl', 'blah');
161 is("@bee", "foo bar burbl blah"); # 44
163 local (undef,@bee) = @bee;
164 is("@bee", "bar burbl blah"); # 45
166 local @bee = ('XXX',@bee,'YYY');
167 is("@bee", "XXX bar burbl blah YYY"); # 46
169 local @bee = local(@bee) = qw(foo bar burbl blah);
170 is("@bee", "foo bar burbl blah"); # 47
172 local (@bim) = local(@bee) = qw(foo bar);
173 is("@bee", "foo bar"); # 48
174 is("@bim", "foo bar"); # 49
176 is("@bee", "foo bar burbl blah"); # 50
178 is("@bee", "XXX bar burbl blah YYY"); # 51
180 is("@bee", "bar burbl blah"); # 52
182 is("@bee", "foo bar burbl blah"); # 53
185 # try the same with my
188 is("@bee", "foo bar burbl blah"); # 54
190 my (undef,@bee) = @bee;
191 is("@bee", "bar burbl blah"); # 55
193 my @bee = ('XXX',@bee,'YYY');
194 is("@bee", "XXX bar burbl blah YYY"); # 56
196 my @bee = my @bee = qw(foo bar burbl blah);
197 is("@bee", "foo bar burbl blah"); # 57
199 my (@bim) = my(@bee) = qw(foo bar);
200 is("@bee", "foo bar"); # 58
201 is("@bim", "foo bar"); # 59
203 is("@bee", "foo bar burbl blah"); # 60
205 is("@bee", "XXX bar burbl blah YYY"); # 61
207 is("@bee", "bar burbl blah"); # 62
209 is("@bee", "foo bar burbl blah"); # 63
212 # try the same with our (except that previous values aren't restored)
215 is("@bee", "foo bar burbl blah");
217 our (undef,@bee) = @bee;
218 is("@bee", "bar burbl blah");
220 our @bee = ('XXX',@bee,'YYY');
221 is("@bee", "XXX bar burbl blah YYY");
223 our @bee = our @bee = qw(foo bar burbl blah);
224 is("@bee", "foo bar burbl blah");
226 our (@bim) = our(@bee) = qw(foo bar);
227 is("@bee", "foo bar");
228 is("@bim", "foo bar");
235 # make sure reification behaves
237 sub reify { $_[1] = $t++; print "@_\n"; }
243 # qw() is no longer a runtime split, it's compiletime.
244 is (qw(foo bar snorfle)[2], 'snorfle');
246 @ary = (12,23,34,45,56);
250 is(push(@ary,56), 4);
251 is(unshift(@ary,12), 5);
257 # $[ should have the same effect regardless of whether the aelem
258 # op is optimized to aelemfast.
263 no warnings 'deprecated';
266 is ($tary[5], $tary[$five]);
273 # bugid #15439 - clearing an array calls destructors which may try
274 # to modify the array - caused 'Attempt to free unreferenced scalar'
278 sub X::DESTROY { @a = () }
279 @a = (bless {}, 'X');
288 # Test negative and funky indices.
308 like($@, qr/Modification of non-creatable array value attempted, subscript -1/, "\$a[-1] = 0");
314 is ($$ref, undef, "\$# on freed array is undef");
316 local $SIG{__WARN__} = sub {push @warn, "@_"};
318 is (scalar @warn, 1);
319 like ($warn[0], qr/^Attempt to set length of freed array/);
324 # Need a new statement to make it go out of scope
326 test_arylen (do {my @a; \$#a});
332 my $outer = \$#array;
334 is (scalar @array, 0);
338 is (scalar @array, 4);
348 is (scalar @array, 0);
351 is (scalar @$ref, 7);
354 is (scalar @array, 0);
359 is (scalar @array, 7);
362 is ($$inner, undef, "orphaned $#foo is always undef");
364 is (scalar @array, 7);
369 is (scalar @array, 7);
372 $$inner = 503; # Bang!
374 is (scalar @array, 7);
404 # Bug #37350 -- once more with a global
418 # more tests for AASSIGN_COMMON
421 our($x,$y,$z) = (1..3);
422 our($y,$z) = ($x,$y);
423 is("$x $y $z", "1 1 2");
426 our($x,$y,$z) = (1..3);
427 (our $y, our $z) = ($x,$y);
428 is("$x $y $z", "1 1 2");
432 "We're included by lib/Tie/Array/std.t so we need to return something true";