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');
26 is(join('',@ary), '12345');
28 $tmp = $ary[$#ary]; --$#ary;
30 # Must do == here beacuse $[ isn't 0
32 is(join('',@ary), '1234');
36 $#ary += 1; # see if element 5 gone for good
42 $r = join(',', $#foo, @foo);
45 $r = join(',', $#foo, @foo);
48 $r = join(',', $#foo, @foo);
53 $r = join(',', $#bar, @bar);
56 $r = join(',', $#bar, @bar);
59 $r = join(',', $#bar, @bar);
62 $r = join(',', $#bar, @bar);
64 reset 'b' if $^O ne 'VMS';
67 $r = join(',', $#bar, @bar);
70 $r = join(',', $#bar, @bar);
73 $foo = 'now is the time';
74 ok(scalar (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)));
80 ok(!($cnt = (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/))))
81 or diag("$cnt $F1:$F2:$Etc");
83 %foo = ('blurfl','dyick','foo','bar','etc.','etc.');
85 is($bar{'foo'}, 'bar');
87 is($bar{'foo'}, undef);
88 (%bar,$a,$b) = (%foo,'how','now');
89 is($bar{'foo'}, 'bar');
90 is($bar{'how'}, 'now');
91 @bar{keys %foo} = values %foo;
92 is($bar{'foo'}, 'bar');
93 is($bar{'how'}, 'now');
95 @foo = grep(/e/,split(' ','now is the time for all good men to come to'));
96 is(join(' ',@foo), 'the time men come');
98 @foo = grep(!/e/,split(' ','now is the time for all good men to come to'));
99 is(join(' ',@foo), 'now is for all good to to');
101 $foo = join('',('a','b','c','d','e','f')[0..5]);
104 $foo = join('',('a','b','c','d','e','f')[0..1]);
107 $foo = join('',('a','b','c','d','e','f')[6]);
110 @foo = ('a','b','c','d','e','f')[0,2,4];
111 @bar = ('a','b','c','d','e','f')[1,3,5];
112 $foo = join('',(@foo,@bar)[0..5]);
115 $foo = ('a','b','c','d','e','f')[0,2,4];
118 $foo = ('a','b','c','d','e','f')[1];
121 @foo = ( 'foo', 'bar', 'burbl');
125 # various AASSIGN_COMMON checks (see newASSIGNOP() in op.c)
130 is("@foo", "foo bar burbl blah"); # 38
133 is("@foo", "bar burbl blah"); # 39
135 @foo = ('XXX',@foo, 'YYY');
136 is("@foo", "XXX bar burbl blah YYY"); # 40
138 @foo = @foo = qw(foo b\a\r bu\\rbl blah);
139 is("@foo", 'foo b\a\r bu\\rbl blah'); # 41
141 @bar = @foo = qw(foo bar); # 42
142 is("@foo", "foo bar");
143 is("@bar", "foo bar"); # 43
145 # try the same with local
146 # XXX tie-stdarray fails the tests involving local, so we use
147 # different variable names to escape the 'tie'
149 @bee = ( 'foo', 'bar', 'burbl', 'blah');
153 is("@bee", "foo bar burbl blah"); # 44
155 local (undef,@bee) = @bee;
156 is("@bee", "bar burbl blah"); # 45
158 local @bee = ('XXX',@bee,'YYY');
159 is("@bee", "XXX bar burbl blah YYY"); # 46
161 local @bee = local(@bee) = qw(foo bar burbl blah);
162 is("@bee", "foo bar burbl blah"); # 47
164 local (@bim) = local(@bee) = qw(foo bar);
165 is("@bee", "foo bar"); # 48
166 is("@bim", "foo bar"); # 49
168 is("@bee", "foo bar burbl blah"); # 50
170 is("@bee", "XXX bar burbl blah YYY"); # 51
172 is("@bee", "bar burbl blah"); # 52
174 is("@bee", "foo bar burbl blah"); # 53
177 # try the same with my
180 is("@bee", "foo bar burbl blah"); # 54
182 my (undef,@bee) = @bee;
183 is("@bee", "bar burbl blah"); # 55
185 my @bee = ('XXX',@bee,'YYY');
186 is("@bee", "XXX bar burbl blah YYY"); # 56
188 my @bee = my @bee = qw(foo bar burbl blah);
189 is("@bee", "foo bar burbl blah"); # 57
191 my (@bim) = my(@bee) = qw(foo bar);
192 is("@bee", "foo bar"); # 58
193 is("@bim", "foo bar"); # 59
195 is("@bee", "foo bar burbl blah"); # 60
197 is("@bee", "XXX bar burbl blah YYY"); # 61
199 is("@bee", "bar burbl blah"); # 62
201 is("@bee", "foo bar burbl blah"); # 63
204 # try the same with our (except that previous values aren't restored)
207 is("@bee", "foo bar burbl blah");
209 our (undef,@bee) = @bee;
210 is("@bee", "bar burbl blah");
212 our @bee = ('XXX',@bee,'YYY');
213 is("@bee", "XXX bar burbl blah YYY");
215 our @bee = our @bee = qw(foo bar burbl blah);
216 is("@bee", "foo bar burbl blah");
218 our (@bim) = our(@bee) = qw(foo bar);
219 is("@bee", "foo bar");
220 is("@bim", "foo bar");
227 # make sure reification behaves
229 sub reify { $_[1] = $t++; print "@_\n"; }
235 # qw() is no longer a runtime split, it's compiletime.
236 is (qw(foo bar snorfle)[2], 'snorfle');
238 @ary = (12,23,34,45,56);
242 is(push(@ary,56), 4);
243 is(unshift(@ary,12), 5);
249 # $[ should have the same effect regardless of whether the aelem
250 # op is optimized to aelemfast.
257 is ($tary[5], $tary[$five]);
264 # bugid #15439 - clearing an array calls destructors which may try
265 # to modify the array - caused 'Attempt to free unreferenced scalar'
269 sub X::DESTROY { @a = () }
270 @a = (bless {}, 'X');
279 # Test negative and funky indices.
299 like($@, qr/Modification of non-creatable array value attempted, subscript -1/, "\$a[-1] = 0");
305 is ($$ref, undef, "\$# on freed array is undef");
307 local $SIG{__WARN__} = sub {push @warn, "@_"};
309 is (scalar @warn, 1);
310 like ($warn[0], qr/^Attempt to set length of freed array/);
315 # Need a new statement to make it go out of scope
317 test_arylen (do {my @a; \$#a});
323 my $outer = \$#array;
325 is (scalar @array, 0);
329 is (scalar @array, 4);
339 is (scalar @array, 0);
342 is (scalar @$ref, 7);
345 is (scalar @array, 0);
350 is (scalar @array, 7);
353 is ($$inner, undef, "orphaned $#foo is always undef");
355 is (scalar @array, 7);
360 is (scalar @array, 7);
363 $$inner = 503; # Bang!
365 is (scalar @array, 7);
395 # Bug #37350 -- once more with a global
409 # more tests for AASSIGN_COMMON
412 our($x,$y,$z) = (1..3);
413 our($y,$z) = ($x,$y);
414 is("$x $y $z", "1 1 2");
417 our($x,$y,$z) = (1..3);
418 (our $y, our $z) = ($x,$y);
419 is("$x $y $z", "1 1 2");
423 "We're included by lib/Tie/Array/std.t so we need to return something true";