Perl_op_sibling_splice(0 remove dead code
[perl.git] / t / op / list.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require "./test.pl";
6     set_up_inc(qw(. ../lib));
7 }
8
9 plan( tests => 72 );
10
11 @foo = (1, 2, 3, 4);
12 cmp_ok($foo[0], '==', 1, 'first elem');
13 cmp_ok($foo[3], '==', 4, 'last elem');
14
15 $_ = join(':',@foo);
16 cmp_ok($_, 'eq', '1:2:3:4', 'join list');
17
18 ($a,$b,$c,$d) = (1,2,3,4);
19 cmp_ok("$a;$b;$c;$d", 'eq', '1;2;3;4', 'list assign');
20
21 ($c,$b,$a) = split(/ /,"111 222 333");
22 cmp_ok("$a;$b;$c",'eq','333;222;111','list split on space');
23
24 ($a,$b,$c) = ($c,$b,$a);
25 cmp_ok("$a;$b;$c",'eq','111;222;333','trio rotate');
26
27 ($a, $b) = ($b, $a);
28 cmp_ok("$a-$b",'eq','222-111','duo swap');
29
30 ($a, $b) = ($b, $a) = ($a, $b);
31 cmp_ok("$a-$b",'eq','222-111','duo swap swap');
32
33 ($a, $b[1], $c{2}, $d) = (1, 2, 3, 4);
34 cmp_ok($a,'==',1,'assign scalar in list');
35 cmp_ok($b[1],'==',2,'assign aelem in list');
36 cmp_ok($c{2},'==',3,'assign helem in list');
37 cmp_ok($d,'==',4,'assign last scalar in list');
38
39 @foo = (1,2,3,4,5,6,7,8);
40 ($a, $b, $c, $d) = @foo;
41 cmp_ok("$a/$b/$c/$d",'eq','1/2/3/4','long list assign');
42
43 @foo = (1,2);
44 ($a, $b, $c, $d) = @foo;
45 cmp_ok($a,'==',1,'short list 1 defined');
46 cmp_ok($b,'==',2,'short list 2 defined');
47 ok(!defined($c),'short list 3 undef');
48 ok(!defined($d),'short list 4 undef');
49
50 @foo = @bar = (1);
51 cmp_ok(join(':',@foo,@bar),'eq','1:1','list reassign');
52
53 @foo = @bar = (2,3);
54 cmp_ok(join(':',join('+',@foo),join('-',@bar)),'eq','2+3:2-3','long list reassign');
55
56 @foo = ();
57 @foo = 1+2+3;
58 cmp_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     }
116 }
117
118 $x = 666;
119 @a = ($x == 12345 || (1,2,3));
120 cmp_ok(join('*',@a),'eq','1*2*3','logical or f');
121
122 @a = ($x == $x || (4,5,6));
123 cmp_ok(join('*',@a),'eq','1','logical or t');
124
125 cmp_ok(join('',1,2,(3,4,5)),'eq','12345','list ..(...)');
126 cmp_ok(join('',(1,2,3,4,5)),'eq','12345','list (.....)');
127 cmp_ok(join('',(1,2,3,4),5),'eq','12345','list (....).');
128 cmp_ok(join('',1,(2,3,4),5),'eq','12345','list .(...).');
129 cmp_ok(join('',1,2,(3,4),5),'eq','12345','list ..(..).');
130 cmp_ok(join('',1,2,3,(4),5),'eq','12345','list ...(.).');
131 cmp_ok(join('',(1,2),3,(4,5)),'eq','12345','list (..).(..)');
132
133 {
134     my @a = (0, undef, undef, 3);
135     my @b = @a[1,2];
136     my @c = (0, undef, undef, 3)[1, 2];
137     cmp_ok(scalar(@b),'==',scalar(@c),'slice and slice');
138     cmp_ok(scalar(@c),'==',2,'slice len');
139
140     @b = (29, scalar @c[()]);
141     cmp_ok(join(':',@b),'eq','29:','slice ary nil');
142
143     my %h = (a => 1);
144     @b = (30, scalar @h{()});
145     cmp_ok(join(':',@b),'eq','30:','slice hash nil');
146
147     my $size = scalar(()[1..1]);
148     cmp_ok($size,'==','0','size nil');
149
150     $size = scalar(()=((1,2,3,4,5)[()])[2,3,4]);
151     is $size, 0, 'slice of empty list from complex expr is empty list';
152
153     @a = (1)[2,3,4];
154     is "@{[ map $_//'undef', @a ]}", "undef undef undef",
155        'slice beyond the end of non-empty list returns undefs';
156 }
157
158 {
159     # perl #39882
160     sub test_two_args {
161         my $test_name = shift;
162         is(scalar(@_), 2, $test_name);
163     }
164     test_two_args("simple list slice",      (10,11)[2,3]);
165     test_two_args("grepped list slice",     grep(1, (10,11)[2,3]));
166     test_two_args("sorted list slice",      sort((10,11)[2,3]));
167     test_two_args("assigned list slice",    my @tmp = (10,11)[2,3]);
168     test_two_args("do-returned list slice", do { (10,11)[2,3]; });
169     test_two_args("list literal slice",     qw(a b)[2,3]);
170     is (()=qw()[2,3], 0, "empty literal slice");
171 }
172
173 {
174     # perl #20321
175     is (join('', @{[('abc'=~/./g)[0,1,2,1,0]]}), "abcba");
176 }
177
178 {
179     is(join('', qw(a b c)[2,0,1]), "cab");
180     my @a = qw(a b c);
181     is(join(":", @a), "a:b:c");
182     my @b = qw();
183     is($#b, -1);
184 }
185
186 {
187     # comma operator with lvalue only propagates the lvalue context to
188     # the last operand.
189     ("const", my $x) ||= 1;
190     is( $x, 1 );
191 }
192
193 # [perl #78194] list slice aliasing op return values
194 sub {
195  is(\$_[0], \$_[1],
196   '[perl #78194] \$_[0] == \$_[1] when @_ aliases elems repeated by lslice'
197  )
198 }
199  ->(("${\''}")[0,0]);
200
201 # [perl #122995] Hang when compiling while(1) in a sub-list
202 # No ok() or is() necessary.
203 sub foo { () = ($a, my $b, ($c, do { while(1) {} })) }
204
205 # List assignment and OPpTARGET_MY
206 {
207     my ($a,$b);
208     my $foo = "foo";
209     my $bar = "bar";
210     ($a,$b) = ($b = $foo."", $a = $bar . "");
211     is("$a,$b", "foo,bar", 'common vars check accounts for OPpTARGET_MY');
212 }
213
214 sub TIESCALAR {bless{}}
215 sub FETCH {$_[0]{fetched}++}
216 sub empty {}
217 tie $t, "";
218 () = (empty(), ($t)x10); # empty() since sub calls usually result in copies
219 is(tied($t)->{fetched}, undef, 'assignment to empty list makes no copies');
220
221 # this was passing a trash SV at the top of the stack to SvIV()
222 ok(($0[()[()]],1), "[perl #126193] list slice with zero indexes");
223
224 # RT #131732: pp_list must extend stack when empty-array arg and not in list
225 # context
226 {
227     my @x;
228     @x;
229     pass('no panic'); # panics only under DEBUGGING
230 }
231
232 fresh_perl_is(<<'EOS', "", {}, "[perl #131954] heap use after free in pp_list");
233 #!./perl
234 BEGIN {
235 my $bar = "bar";
236
237 sub test_no_error {
238     eval $_[0];
239 }
240
241 test_no_error($_) for split /\n/,
242 q[      x
243         definfoo, $bar;
244         x
245         x
246         x
247         grep((not $bar, $bar, $bar), $bar);
248         x
249         x
250     x
251         x
252         x
253         x
254         x
255         x
256         x
257         x
258         x
259         x
260         x
261        x
262         x
263         x
264         x
265         x
266         x
267         x
268  ];
269 }
270 EOS