Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
bc58e674 DL |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
cbce292e | 5 | require "./test.pl"; |
624c42e2 | 6 | set_up_inc(qw(. ../lib)); |
bc58e674 DL |
7 | } |
8 | ||
8ef9070b | 9 | plan( tests => 73 ); |
8d063cd8 LW |
10 | |
11 | @foo = (1, 2, 3, 4); | |
bc58e674 DL |
12 | cmp_ok($foo[0], '==', 1, 'first elem'); |
13 | cmp_ok($foo[3], '==', 4, 'last elem'); | |
8d063cd8 | 14 | |
a687059c | 15 | $_ = join(':',@foo); |
bc58e674 | 16 | cmp_ok($_, 'eq', '1:2:3:4', 'join list'); |
8d063cd8 LW |
17 | |
18 | ($a,$b,$c,$d) = (1,2,3,4); | |
bc58e674 | 19 | cmp_ok("$a;$b;$c;$d", 'eq', '1;2;3;4', 'list assign'); |
8d063cd8 LW |
20 | |
21 | ($c,$b,$a) = split(/ /,"111 222 333"); | |
bc58e674 | 22 | cmp_ok("$a;$b;$c",'eq','333;222;111','list split on space'); |
8d063cd8 LW |
23 | |
24 | ($a,$b,$c) = ($c,$b,$a); | |
bc58e674 | 25 | cmp_ok("$a;$b;$c",'eq','111;222;333','trio rotate'); |
8d063cd8 LW |
26 | |
27 | ($a, $b) = ($b, $a); | |
bc58e674 DL |
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'); | |
8d063cd8 LW |
32 | |
33 | ($a, $b[1], $c{2}, $d) = (1, 2, 3, 4); | |
bc58e674 DL |
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'); | |
8d063cd8 LW |
38 | |
39 | @foo = (1,2,3,4,5,6,7,8); | |
40 | ($a, $b, $c, $d) = @foo; | |
bc58e674 DL |
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'); | |
378cc40b | 49 | |
a687059c | 50 | @foo = @bar = (1); |
bc58e674 DL |
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'); | |
378cc40b LW |
55 | |
56 | @foo = (); | |
57 | @foo = 1+2+3; | |
bc58e674 DL |
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 | } | |
378cc40b LW |
116 | } |
117 | ||
bc58e674 | 118 | $x = 666; |
378cc40b | 119 | @a = ($x == 12345 || (1,2,3)); |
bc58e674 | 120 | cmp_ok(join('*',@a),'eq','1*2*3','logical or f'); |
378cc40b LW |
121 | |
122 | @a = ($x == $x || (4,5,6)); | |
bc58e674 DL |
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 (..).(..)'); | |
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'); |
cbce292e FC |
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'; | |
c73bf8e3 | 156 | } |
42e73ed0 RD |
157 | |
158 | { | |
159 | # perl #39882 | |
cbce292e | 160 | sub test_two_args { |
42e73ed0 | 161 | my $test_name = shift; |
cbce292e | 162 | is(scalar(@_), 2, $test_name); |
42e73ed0 | 163 | } |
cbce292e FC |
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"); | |
42e73ed0 RD |
171 | } |
172 | ||
2b676593 BB |
173 | { |
174 | # perl #20321 | |
175 | is (join('', @{[('abc'=~/./g)[0,1,2,1,0]]}), "abcba"); | |
176 | } | |
ea25a9b2 Z |
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 | } | |
5c906035 GG |
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 | } | |
2d885586 FC |
192 | |
193 | # [perl #78194] list slice aliasing op return values | |
2d885586 FC |
194 | sub { |
195 | is(\$_[0], \$_[1], | |
196 | '[perl #78194] \$_[0] == \$_[1] when @_ aliases elems repeated by lslice' | |
197 | ) | |
198 | } | |
199 | ->(("${\''}")[0,0]); | |
0d42e778 FC |
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) {} })) } | |
0017a11a FC |
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 | } | |
5a8cd187 FC |
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'); | |
9e59c36b TC |
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"); | |
b54564c3 AC |
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 | } | |
57bd6600 TC |
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 | |
8ef9070b DM |
271 | |
272 | # this used to SEGV due to deep recursion in Perl_list() | |
273 | ||
274 | { | |
275 | my $e = "1"; $e = "(1,$e)" for 1..100_000; $e = "() = $e"; eval $e; | |
276 | is $@, "", "SEGV in Perl_list"; | |
277 | } |