This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refactor die_exit.t to loop over a list, rather than iterate on an hash.
[perl5.git] / t / op / array.t
CommitLineData
a687059c
LW
1#!./perl
2
6b42d12b
DM
3BEGIN {
4 chdir 't' if -d 't';
404a4710 5 @INC = ('.', '../lib');
6b42d12b
DM
6}
7
0dd3f902
NC
8require 'test.pl';
9
8f878375 10plan (128);
a687059c 11
05fc92f1
GS
12#
13# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
14#
15
a687059c 16@ary = (1,2,3,4,5);
0dd3f902 17is(join('',@ary), '12345');
a687059c
LW
18
19$tmp = $ary[$#ary]; --$#ary;
0dd3f902
NC
20is($tmp, 5);
21is($#ary, 3);
22is(join('',@ary), '1234');
a687059c 23
136c2a5e
NC
24{
25 no warnings 'deprecated';
26
a687059c
LW
27$[ = 1;
28@ary = (1,2,3,4,5);
0dd3f902 29is(join('',@ary), '12345');
a687059c
LW
30
31$tmp = $ary[$#ary]; --$#ary;
0dd3f902
NC
32is($tmp, 5);
33# Must do == here beacuse $[ isn't 0
34ok($#ary == 4);
35is(join('',@ary), '1234');
a687059c 36
0dd3f902 37is($ary[5], undef);
a687059c 38
a0d0e21e 39$#ary += 1; # see if element 5 gone for good
0dd3f902
NC
40ok($#ary == 5);
41ok(!defined $ary[5]);
a687059c
LW
42
43$[ = 0;
44@foo = ();
45$r = join(',', $#foo, @foo);
0dd3f902 46is($r, "-1");
a687059c
LW
47$foo[0] = '0';
48$r = join(',', $#foo, @foo);
0dd3f902 49is($r, "0,0");
a687059c
LW
50$foo[2] = '2';
51$r = join(',', $#foo, @foo);
0dd3f902 52is($r, "2,0,,2");
a687059c
LW
53@bar = ();
54$bar[0] = '0';
55$bar[1] = '1';
56$r = join(',', $#bar, @bar);
0dd3f902 57is($r, "1,0,1");
a687059c
LW
58@bar = ();
59$r = join(',', $#bar, @bar);
0dd3f902 60is($r, "-1");
a687059c
LW
61$bar[0] = '0';
62$r = join(',', $#bar, @bar);
0dd3f902 63is($r, "0,0");
a687059c
LW
64$bar[2] = '2';
65$r = join(',', $#bar, @bar);
0dd3f902 66is($r, "2,0,,2");
14ce8c55 67reset 'b' if $^O ne 'VMS';
a687059c
LW
68@bar = ();
69$bar[0] = '0';
70$r = join(',', $#bar, @bar);
0dd3f902 71is($r, "0,0");
a687059c
LW
72$bar[2] = '2';
73$r = join(',', $#bar, @bar);
0dd3f902 74is($r, "2,0,,2");
a687059c 75
136c2a5e
NC
76}
77
a687059c 78$foo = 'now is the time';
0dd3f902
NC
79ok(scalar (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)));
80is($F1, 'now');
81is($F2, 'is');
82is($Etc, 'the time');
a687059c
LW
83
84$foo = 'lskjdf';
0dd3f902
NC
85ok(!($cnt = (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/))))
86 or diag("$cnt $F1:$F2:$Etc");
a687059c
LW
87
88%foo = ('blurfl','dyick','foo','bar','etc.','etc.');
89%bar = %foo;
0dd3f902 90is($bar{'foo'}, 'bar');
a687059c 91%bar = ();
0dd3f902 92is($bar{'foo'}, undef);
a687059c 93(%bar,$a,$b) = (%foo,'how','now');
0dd3f902
NC
94is($bar{'foo'}, 'bar');
95is($bar{'how'}, 'now');
a687059c 96@bar{keys %foo} = values %foo;
0dd3f902
NC
97is($bar{'foo'}, 'bar');
98is($bar{'how'}, 'now');
a687059c
LW
99
100@foo = grep(/e/,split(' ','now is the time for all good men to come to'));
0dd3f902 101is(join(' ',@foo), 'the time men come');
a687059c
LW
102
103@foo = grep(!/e/,split(' ','now is the time for all good men to come to'));
0dd3f902 104is(join(' ',@foo), 'now is for all good to to');
79a0689e
LW
105
106$foo = join('',('a','b','c','d','e','f')[0..5]);
0dd3f902 107is($foo, 'abcdef');
79a0689e
LW
108
109$foo = join('',('a','b','c','d','e','f')[0..1]);
0dd3f902 110is($foo, 'ab');
79a0689e
LW
111
112$foo = join('',('a','b','c','d','e','f')[6]);
0dd3f902 113is($foo, '');
79a0689e
LW
114
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]);
0dd3f902 118is($foo, 'acebdf');
79a0689e
LW
119
120$foo = ('a','b','c','d','e','f')[0,2,4];
0dd3f902 121is($foo, 'e');
79a0689e
LW
122
123$foo = ('a','b','c','d','e','f')[1];
0dd3f902 124is($foo, 'b');
a0231f0e 125
c6aa4a32 126@foo = ( 'foo', 'bar', 'burbl');
136c2a5e
NC
127{
128 no warnings 'deprecated';
129 push(foo, 'blah');
130}
0dd3f902 131is($#foo, 3);
b3381831
GS
132
133# various AASSIGN_COMMON checks (see newASSIGNOP() in op.c)
134
0dd3f902 135#curr_test(38);
b3381831
GS
136
137@foo = @foo;
0dd3f902 138is("@foo", "foo bar burbl blah"); # 38
b3381831
GS
139
140(undef,@foo) = @foo;
0dd3f902 141is("@foo", "bar burbl blah"); # 39
b3381831
GS
142
143@foo = ('XXX',@foo, 'YYY');
0dd3f902 144is("@foo", "XXX bar burbl blah YYY"); # 40
b3381831 145
3201ebbd 146@foo = @foo = qw(foo b\a\r bu\\rbl blah);
0dd3f902 147is("@foo", 'foo b\a\r bu\\rbl blah'); # 41
b3381831
GS
148
149@bar = @foo = qw(foo bar); # 42
0dd3f902
NC
150is("@foo", "foo bar");
151is("@bar", "foo bar"); # 43
b3381831
GS
152
153# try the same with local
05fc92f1
GS
154# XXX tie-stdarray fails the tests involving local, so we use
155# different variable names to escape the 'tie'
156
157@bee = ( 'foo', 'bar', 'burbl', 'blah');
b3381831
GS
158{
159
05fc92f1 160 local @bee = @bee;
0dd3f902 161 is("@bee", "foo bar burbl blah"); # 44
b3381831 162 {
05fc92f1 163 local (undef,@bee) = @bee;
0dd3f902 164 is("@bee", "bar burbl blah"); # 45
b3381831 165 {
05fc92f1 166 local @bee = ('XXX',@bee,'YYY');
0dd3f902 167 is("@bee", "XXX bar burbl blah YYY"); # 46
b3381831 168 {
05fc92f1 169 local @bee = local(@bee) = qw(foo bar burbl blah);
0dd3f902 170 is("@bee", "foo bar burbl blah"); # 47
b3381831 171 {
05fc92f1 172 local (@bim) = local(@bee) = qw(foo bar);
0dd3f902
NC
173 is("@bee", "foo bar"); # 48
174 is("@bim", "foo bar"); # 49
b3381831 175 }
0dd3f902 176 is("@bee", "foo bar burbl blah"); # 50
b3381831 177 }
0dd3f902 178 is("@bee", "XXX bar burbl blah YYY"); # 51
b3381831 179 }
0dd3f902 180 is("@bee", "bar burbl blah"); # 52
b3381831 181 }
0dd3f902 182 is("@bee", "foo bar burbl blah"); # 53
b3381831
GS
183}
184
185# try the same with my
186{
05fc92f1 187 my @bee = @bee;
0dd3f902 188 is("@bee", "foo bar burbl blah"); # 54
b3381831 189 {
05fc92f1 190 my (undef,@bee) = @bee;
0dd3f902 191 is("@bee", "bar burbl blah"); # 55
b3381831 192 {
05fc92f1 193 my @bee = ('XXX',@bee,'YYY');
0dd3f902 194 is("@bee", "XXX bar burbl blah YYY"); # 56
b3381831 195 {
05fc92f1 196 my @bee = my @bee = qw(foo bar burbl blah);
0dd3f902 197 is("@bee", "foo bar burbl blah"); # 57
b3381831 198 {
05fc92f1 199 my (@bim) = my(@bee) = qw(foo bar);
0dd3f902
NC
200 is("@bee", "foo bar"); # 58
201 is("@bim", "foo bar"); # 59
b3381831 202 }
0dd3f902 203 is("@bee", "foo bar burbl blah"); # 60
b3381831 204 }
0dd3f902 205 is("@bee", "XXX bar burbl blah YYY"); # 61
b3381831 206 }
0dd3f902 207 is("@bee", "bar burbl blah"); # 62
b3381831 208 }
0dd3f902 209 is("@bee", "foo bar burbl blah"); # 63
b3381831
GS
210}
211
f17e6c41
RGS
212# try the same with our (except that previous values aren't restored)
213{
214 our @bee = @bee;
215 is("@bee", "foo bar burbl blah");
216 {
217 our (undef,@bee) = @bee;
218 is("@bee", "bar burbl blah");
219 {
220 our @bee = ('XXX',@bee,'YYY');
221 is("@bee", "XXX bar burbl blah YYY");
222 {
223 our @bee = our @bee = qw(foo bar burbl blah);
224 is("@bee", "foo bar burbl blah");
225 {
226 our (@bim) = our(@bee) = qw(foo bar);
227 is("@bee", "foo bar");
228 is("@bim", "foo bar");
229 }
230 }
231 }
232 }
233}
234
352edd90 235# make sure reification behaves
0dd3f902
NC
236my $t = curr_test();
237sub reify { $_[1] = $t++; print "@_\n"; }
352edd90
GS
238reify('ok');
239reify('ok');
9d001be8 240
0dd3f902 241curr_test($t);
7517970f 242
0dd3f902
NC
243# qw() is no longer a runtime split, it's compiletime.
244is (qw(foo bar snorfle)[2], 'snorfle');
7517970f 245
0dd3f902 246@ary = (12,23,34,45,56);
7517970f 247
0dd3f902
NC
248is(shift(@ary), 12);
249is(pop(@ary), 56);
250is(push(@ary,56), 4);
251is(unshift(@ary,12), 5);
4c8f17b9
BH
252
253sub foo { "a" }
254@foo=(foo())[0,0];
0dd3f902 255is ($foo[1], "a");
b0840a2a
RH
256
257# $[ should have the same effect regardless of whether the aelem
258# op is optimized to aelemfast.
259
0dd3f902
NC
260
261
b0840a2a 262sub tary {
136c2a5e 263 no warnings 'deprecated';
b0840a2a
RH
264 local $[ = 10;
265 my $five = 5;
0dd3f902 266 is ($tary[5], $tary[$five]);
b0840a2a
RH
267}
268
269@tary = (0..50);
270tary();
6b42d12b
DM
271
272
6b42d12b
DM
273# bugid #15439 - clearing an array calls destructors which may try
274# to modify the array - caused 'Attempt to free unreferenced scalar'
275
276my $got = runperl (
277 prog => q{
278 sub X::DESTROY { @a = () }
3d7a9343 279 @a = (bless {}, q{X});
6b42d12b
DM
280 @a = ();
281 },
282 stderr => 1
283 );
284
285$got =~ s/\n/ /g;
0dd3f902 286is ($got, '');
2b573ace
JH
287
288# Test negative and funky indices.
289
0dd3f902 290
2b573ace
JH
291{
292 my @a = 0..4;
0dd3f902
NC
293 is($a[-1], 4);
294 is($a[-2], 3);
295 is($a[-5], 0);
296 ok(!defined $a[-6]);
297
298 is($a[2.1] , 2);
299 is($a[2.9] , 2);
300 is($a[undef], 0);
301 is($a["3rd"], 3);
2b573ace
JH
302}
303
2b573ace
JH
304
305{
306 my @a;
307 eval '$a[-1] = 0';
0dd3f902 308 like($@, qr/Modification of non-creatable array value attempted, subscript -1/, "\$a[-1] = 0");
2b573ace 309}
0dd3f902 310
1b20cd17
NC
311sub test_arylen {
312 my $ref = shift;
83bf042f 313 local $^W = 1;
1b20cd17 314 is ($$ref, undef, "\$# on freed array is undef");
83bf042f
NC
315 my @warn;
316 local $SIG{__WARN__} = sub {push @warn, "@_"};
1b20cd17 317 $$ref = 1000;
83bf042f
NC
318 is (scalar @warn, 1);
319 like ($warn[0], qr/^Attempt to set length of freed array/);
320}
1b20cd17
NC
321
322{
323 my $a = \$#{[]};
324 # Need a new statement to make it go out of scope
325 test_arylen ($a);
326 test_arylen (do {my @a; \$#a});
327}
404a4710
NC
328
329{
330 use vars '@array';
331
332 my $outer = \$#array;
333 is ($$outer, -1);
334 is (scalar @array, 0);
335
336 $$outer = 3;
337 is ($$outer, 3);
338 is (scalar @array, 4);
339
340 my $ref = \@array;
341
404a4710
NC
342 my $inner;
343 {
344 local @array;
345 $inner = \$#array;
346
347 is ($$inner, -1);
348 is (scalar @array, 0);
349 $$outer = 6;
350
351 is (scalar @$ref, 7);
352
353 is ($$inner, -1);
354 is (scalar @array, 0);
355
356 $$inner = 42;
357 }
358
359 is (scalar @array, 7);
360 is ($$outer, 6);
361
2fc04a10 362 is ($$inner, undef, "orphaned $#foo is always undef");
404a4710
NC
363
364 is (scalar @array, 7);
365 is ($$outer, 6);
366
367 $$inner = 1;
368
369 is (scalar @array, 7);
370 is ($$outer, 6);
371
372 $$inner = 503; # Bang!
373
374 is (scalar @array, 7);
375 is ($$outer, 6);
376}
377
378{
379 # Bug #36211
380 use vars '@array';
381 for (1,2) {
382 {
383 local @a;
384 is ($#a, -1);
385 @a=(1..4)
386 }
387 }
388}
389
e4c5ccf3
RH
390{
391 # Bug #37350
392 my @array = (1..4);
393 $#{@array} = 7;
394 is ($#{4}, 7);
395
396 my $x;
397 $#{$x} = 3;
398 is(scalar @$x, 4);
399
400 push @{@array}, 23;
401 is ($4[8], 23);
402}
403{
404 # Bug #37350 -- once more with a global
405 use vars '@array';
406 @array = (1..4);
407 $#{@array} = 7;
408 is ($#{4}, 7);
409
410 my $x;
411 $#{$x} = 3;
412 is(scalar @$x, 4);
413
414 push @{@array}, 23;
415 is ($4[8], 23);
416}
417
f17e6c41
RGS
418# more tests for AASSIGN_COMMON
419
420{
421 our($x,$y,$z) = (1..3);
422 our($y,$z) = ($x,$y);
423 is("$x $y $z", "1 1 2");
424}
425{
426 our($x,$y,$z) = (1..3);
427 (our $y, our $z) = ($x,$y);
428 is("$x $y $z", "1 1 2");
429}
430
0f907b96
FC
431# [perl #70171]
432{
433 my $x = get_x(); my %x = %$x; sub get_x { %x=(1..4); return \%x };
434 is(
435 join(" ", map +($_,$x{$_}), sort keys %x), "1 2 3 4",
436 'bug 70171 (self-assignment via my %x = %$x)'
437 );
438 my $y = get_y(); my @y = @$y; sub get_y { @y=(1..4); return \@y };
439 is(
440 "@y", "1 2 3 4",
441 'bug 70171 (self-assignment via my @x = @$x)'
442 );
443}
444
8f878375
FC
445*trit = *scile; $trit[0];
446ok(1, 'aelem_fast on a nonexistent array does not crash');
f17e6c41 447
404a4710 448"We're included by lib/Tie/Array/std.t so we need to return something true";