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);
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
181 is("@bee", "foo bar burbl blah"); # 54
183 my (undef,@bee) = @bee;
184 is("@bee", "bar burbl blah"); # 55
186 my @bee = ('XXX',@bee,'YYY');
187 is("@bee", "XXX bar burbl blah YYY"); # 56
189 my @bee = my @bee = qw(foo bar burbl blah);
190 is("@bee", "foo bar burbl blah"); # 57
192 my (@bim) = my(@bee) = qw(foo bar);
193 is("@bee", "foo bar"); # 58
194 is("@bim", "foo bar"); # 59
196 is("@bee", "foo bar burbl blah"); # 60
198 is("@bee", "XXX bar burbl blah YYY"); # 61
200 is("@bee", "bar burbl blah"); # 62
202 is("@bee", "foo bar burbl blah"); # 63
205 # make sure reification behaves
207 sub reify { $_[1] = $t++; print "@_\n"; }
213 # qw() is no longer a runtime split, it's compiletime.
214 is (qw(foo bar snorfle)[2], 'snorfle');
216 @ary = (12,23,34,45,56);
220 is(push(@ary,56), 4);
221 is(unshift(@ary,12), 5);
227 # $[ should have the same effect regardless of whether the aelem
228 # op is optimized to aelemfast.
235 is ($tary[5], $tary[$five]);
242 # bugid #15439 - clearing an array calls destructors which may try
243 # to modify the array - caused 'Attempt to free unreferenced scalar'
247 sub X::DESTROY { @a = () }
248 @a = (bless {}, 'X');
257 # Test negative and funky indices.
277 like($@, qr/Modification of non-creatable array value attempted, subscript -1/, "\$a[-1] = 0");
283 is ($$ref, undef, "\$# on freed array is undef");
285 local $SIG{__WARN__} = sub {push @warn, "@_"};
287 is (scalar @warn, 1);
288 like ($warn[0], qr/^Attempt to set length of freed array/);
293 # Need a new statement to make it go out of scope
295 test_arylen (do {my @a; \$#a});
301 my $outer = \$#array;
303 is (scalar @array, 0);
307 is (scalar @array, 4);
317 is (scalar @array, 0);
320 is (scalar @$ref, 7);
323 is (scalar @array, 0);
328 is (scalar @array, 7);
331 is ($$inner, undef, "orphaned $#foo is always undef");
333 is (scalar @array, 7);
338 is (scalar @array, 7);
341 $$inner = 503; # Bang!
343 is (scalar @array, 7);
373 # Bug #37350 -- once more with a global
387 "We're included by lib/Tie/Array/std.t so we need to return something true";