This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #78194] Make list slices copy PADTMPs in lv cx
[perl5.git] / t / op / list.t
CommitLineData
8d063cd8
LW
1#!./perl
2
bc58e674
DL
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = qw(. ../lib);
6}
7
8require "test.pl";
2d885586 9plan( tests => 65 );
8d063cd8
LW
10
11@foo = (1, 2, 3, 4);
bc58e674
DL
12cmp_ok($foo[0], '==', 1, 'first elem');
13cmp_ok($foo[3], '==', 4, 'last elem');
8d063cd8 14
a687059c 15$_ = join(':',@foo);
bc58e674 16cmp_ok($_, 'eq', '1:2:3:4', 'join list');
8d063cd8
LW
17
18($a,$b,$c,$d) = (1,2,3,4);
bc58e674 19cmp_ok("$a;$b;$c;$d", 'eq', '1;2;3;4', 'list assign');
8d063cd8
LW
20
21($c,$b,$a) = split(/ /,"111 222 333");
bc58e674 22cmp_ok("$a;$b;$c",'eq','333;222;111','list split on space');
8d063cd8
LW
23
24($a,$b,$c) = ($c,$b,$a);
bc58e674 25cmp_ok("$a;$b;$c",'eq','111;222;333','trio rotate');
8d063cd8
LW
26
27($a, $b) = ($b, $a);
bc58e674
DL
28cmp_ok("$a-$b",'eq','222-111','duo swap');
29
30($a, $b) = ($b, $a) = ($a, $b);
31cmp_ok("$a-$b",'eq','222-111','duo swap swap');
8d063cd8
LW
32
33($a, $b[1], $c{2}, $d) = (1, 2, 3, 4);
bc58e674
DL
34cmp_ok($a,'==',1,'assign scalar in list');
35cmp_ok($b[1],'==',2,'assign aelem in list');
36cmp_ok($c{2},'==',3,'assign helem in list');
37cmp_ok($d,'==',4,'assign last scalar in list');
8d063cd8
LW
38
39@foo = (1,2,3,4,5,6,7,8);
40($a, $b, $c, $d) = @foo;
bc58e674
DL
41cmp_ok("$a/$b/$c/$d",'eq','1/2/3/4','long list assign');
42
43@foo = (1,2);
44($a, $b, $c, $d) = @foo;
45cmp_ok($a,'==',1,'short list 1 defined');
46cmp_ok($b,'==',2,'short list 2 defined');
47ok(!defined($c),'short list 3 undef');
48ok(!defined($d),'short list 4 undef');
378cc40b 49
a687059c 50@foo = @bar = (1);
bc58e674
DL
51cmp_ok(join(':',@foo,@bar),'eq','1:1','list reassign');
52
53@foo = @bar = (2,3);
54cmp_ok(join(':',join('+',@foo),join('-',@bar)),'eq','2+3:2-3','long list reassign');
378cc40b
LW
55
56@foo = ();
57@foo = 1+2+3;
bc58e674
DL
58cmp_ok(join(':',@foo),'eq','6','scalar assign to array');
59
60{
61 my ($a, $b, $c);
62 for ($x = 0; $x < 3; $x = $x + 1) {
63 ($a, $b, $c) =
64 $x == 0 ? ('a','b','c')
65 : $x == 1 ? ('d','e','f')
66 : ('g','h','i')
67 ;
68 if ($x == 0) {
69 cmp_ok($a,'eq','a','ternary for a 1');
70 cmp_ok($b,'eq','b','ternary for b 1');
71 cmp_ok($c,'eq','c','ternary for c 1');
72 }
73 if ($x == 1) {
74 cmp_ok($a,'eq','d','ternary for a 2');
75 cmp_ok($b,'eq','e','ternary for b 2');
76 cmp_ok($c,'eq','f','ternary for c 2');
77 }
78 if ($x == 2) {
79 cmp_ok($a,'eq','g','ternary for a 3');
80 cmp_ok($b,'eq','h','ternary for b 3');
81 cmp_ok($c,'eq','i','ternary for c 3');
82 }
83 }
84}
85
86{
87 my ($a, $b, $c);
88 for ($x = 0; $x < 3; $x = $x + 1) {
89 ($a, $b, $c) = do {
90 if ($x == 0) {
91 ('a','b','c');
92 }
93 elsif ($x == 1) {
94 ('d','e','f');
95 }
96 else {
97 ('g','h','i');
98 }
99 };
100 if ($x == 0) {
101 cmp_ok($a,'eq','a','block for a 1');
102 cmp_ok($b,'eq','b','block for b 1');
103 cmp_ok($c,'eq','c','block for c 1');
104 }
105 if ($x == 1) {
106 cmp_ok($a,'eq','d','block for a 2');
107 cmp_ok($b,'eq','e','block for b 2');
108 cmp_ok($c,'eq','f','block for c 2');
109 }
110 if ($x == 2) {
111 cmp_ok($a,'eq','g','block for a 3');
112 cmp_ok($b,'eq','h','block for b 3');
113 cmp_ok($c,'eq','i','block for c 3');
114 }
115 }
378cc40b
LW
116}
117
bc58e674 118$x = 666;
378cc40b 119@a = ($x == 12345 || (1,2,3));
bc58e674 120cmp_ok(join('*',@a),'eq','1*2*3','logical or f');
378cc40b
LW
121
122@a = ($x == $x || (4,5,6));
bc58e674
DL
123cmp_ok(join('*',@a),'eq','1','logical or t');
124
125cmp_ok(join('',1,2,(3,4,5)),'eq','12345','list ..(...)');
126cmp_ok(join('',(1,2,3,4,5)),'eq','12345','list (.....)');
127cmp_ok(join('',(1,2,3,4),5),'eq','12345','list (....).');
128cmp_ok(join('',1,(2,3,4),5),'eq','12345','list .(...).');
129cmp_ok(join('',1,2,(3,4),5),'eq','12345','list ..(..).');
130cmp_ok(join('',1,2,3,(4),5),'eq','12345','list ...(.).');
131cmp_ok(join('',(1,2),3,(4,5)),'eq','12345','list (..).(..)');
a687059c 132
c73bf8e3
HS
133{
134 my @a = (0, undef, undef, 3);
135 my @b = @a[1,2];
136 my @c = (0, undef, undef, 3)[1, 2];
bc58e674
DL
137 cmp_ok(scalar(@b),'==',scalar(@c),'slice and slice');
138 cmp_ok(scalar(@c),'==',2,'slice len');
04ab2c87
RD
139
140 @b = (29, scalar @c[()]);
bc58e674 141 cmp_ok(join(':',@b),'eq','29:','slice ary nil');
04ab2c87
RD
142
143 my %h = (a => 1);
144 @b = (30, scalar @h{()});
bc58e674 145 cmp_ok(join(':',@b),'eq','30:','slice hash nil');
59abd335 146
7f6b17e4 147 my $size = scalar(()[1..1]);
bc58e674 148 cmp_ok($size,'==','0','size nil');
c73bf8e3 149}
42e73ed0
RD
150
151{
152 # perl #39882
153 sub test_zero_args {
154 my $test_name = shift;
155 is(scalar(@_), 0, $test_name);
156 }
157 test_zero_args("simple list slice", (10,11)[2,3]);
158 test_zero_args("grepped list slice", grep(1, (10,11)[2,3]));
159 test_zero_args("sorted list slice", sort((10,11)[2,3]));
160 test_zero_args("assigned list slice", my @tmp = (10,11)[2,3]);
161 test_zero_args("do-returned list slice", do { (10,11)[2,3]; });
ea25a9b2
Z
162 test_zero_args("list literal slice", qw(a b)[2,3]);
163 test_zero_args("empty literal slice", qw()[2,3]);
42e73ed0
RD
164}
165
2b676593
BB
166{
167 # perl #20321
168 is (join('', @{[('abc'=~/./g)[0,1,2,1,0]]}), "abcba");
169}
ea25a9b2
Z
170
171{
172 is(join('', qw(a b c)[2,0,1]), "cab");
173 my @a = qw(a b c);
174 is(join(":", @a), "a:b:c");
175 my @b = qw();
176 is($#b, -1);
177}
5c906035
GG
178
179{
180 # comma operator with lvalue only propagates the lvalue context to
181 # the last operand.
182 ("const", my $x) ||= 1;
183 is( $x, 1 );
184}
2d885586
FC
185
186# [perl #78194] list slice aliasing op return values
2d885586
FC
187sub {
188 is(\$_[0], \$_[1],
189 '[perl #78194] \$_[0] == \$_[1] when @_ aliases elems repeated by lslice'
190 )
191}
192 ->(("${\''}")[0,0]);