6 @INC = ('.', '../lib', '../ext/B/t');
12 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
13 print "1..0 # Skip -- Perl configured without B module\n";
16 if (!$Config::Config{useperlio}) {
17 print "1..0 # Skip -- need perlio to walk the optree\n";
20 # require q(test.pl); # now done by OptreeCheck
28 Code test snippets here are adapted from `perldoc -f map`
30 Due to a bleadperl optimization (Dave Mitchell, circa may 04), the
31 (map|grep)(start|while) opcodes have different flags in 5.9, their
32 private flags /1, /2 are gone in blead (for the cases covered)
34 When the optree stuff was integrated into 5.8.6, these tests failed,
35 and were todo'd. Theyre now done, by version-specific tweaking in
36 mkCheckRex(), therefore the skip is removed too.
41 # examples shamelessly snatched from perldoc -f map
47 # chunk: # translates a list of numbers to the corresponding characters.
48 @chars = map(chr, @nums);
52 checkOptree(note => q{},
54 code => q{@chars = map(chr, @nums); },
55 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
56 # 1 <;> nextstate(main 475 (eval 10):1) v
60 # 5 <1> rv2av[t7] lKM/1
62 # 7 <|> mapwhile(other->8)[t8] lK
68 # c <1> rv2av[t2] lKRM*/1
69 # d <2> aassign[t9] KS/COMMON
70 # e <1> leavesub[1 ref] K/REFC,1
72 # 1 <;> nextstate(main 559 (eval 15):1) v
76 # 5 <1> rv2av[t4] lKM/1
78 # 7 <|> mapwhile(other->8)[t5] lK
84 # c <1> rv2av[t1] lKRM*/1
85 # d <2> aassign[t6] KS/COMMON
86 # e <1> leavesub[1 ref] K/REFC,1
92 # chunk: %hash = map { getkey($_) => $_ } @array;
96 checkOptree(note => q{},
98 code => q{%hash = map { getkey($_) => $_ } @array; },
99 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
100 # 1 <;> nextstate(main 476 (eval 10):1) v:{
104 # 5 <1> rv2av[t8] lKM/1
106 # 7 <|> mapwhile(other->8)[t9] lK
108 # 9 <;> nextstate(main 475 (eval 10):1) v:{
112 # d <#> gv[*getkey] s/EARLYCV
113 # e <1> entersub[t5] lKS/TARG,1
120 # k <1> rv2hv[t2] lKRM*/1
121 # l <2> aassign[t10] KS/COMMON
122 # m <1> leavesub[1 ref] K/REFC,1
124 # 1 <;> nextstate(main 560 (eval 15):1) v:{
128 # 5 <1> rv2av[t3] lKM/1
130 # 7 <|> mapwhile(other->8)[t4] lK
132 # 9 <;> nextstate(main 559 (eval 15):1) v:{
136 # d <$> gv(*getkey) s/EARLYCV
137 # e <1> entersub[t2] lKS/TARG,1
144 # k <1> rv2hv[t1] lKRM*/1
145 # l <2> aassign[t5] KS/COMMON
146 # m <1> leavesub[1 ref] K/REFC,1
154 foreach $_ (@array) {
155 $hash{getkey($_)} = $_;
161 checkOptree(note => q{},
163 code => q{{ %hash = (); foreach $_ (@array) { $hash{getkey($_)} = $_; } } },
164 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
165 # 1 <;> nextstate(main 478 (eval 10):1) v:{
166 # 2 <{> enterloop(next->u last->u redo->3)
167 # 3 <;> nextstate(main 475 (eval 10):1) v
171 # 7 <1> rv2hv[t2] lKRM*/1
172 # 8 <2> aassign[t3] vKS
173 # 9 <;> nextstate(main 476 (eval 10):1) v:{
176 # c <1> rv2av[t6] sKRM/1
179 # f <{> enteriter(next->q last->t redo->g) lKS/8
181 # s <|> and(other->g) K/1
182 # g <;> nextstate(main 475 (eval 10):1) v:{
188 # m <#> gv[*getkey] s/EARLYCV
189 # n <1> entersub[t10] sKS/TARG,1
190 # o <2> helem sKRM*/2
191 # p <2> sassign vKS/2
194 # t <2> leaveloop K/2
195 # u <2> leaveloop K/2
196 # v <1> leavesub[1 ref] K/REFC,1
198 # 1 <;> nextstate(main 562 (eval 15):1) v:{
199 # 2 <{> enterloop(next->u last->u redo->3)
200 # 3 <;> nextstate(main 559 (eval 15):1) v
204 # 7 <1> rv2hv[t1] lKRM*/1
205 # 8 <2> aassign[t2] vKS
206 # 9 <;> nextstate(main 560 (eval 15):1) v:{
209 # c <1> rv2av[t3] sKRM/1
212 # f <{> enteriter(next->q last->t redo->g) lKS/8
214 # s <|> and(other->g) K/1
215 # g <;> nextstate(main 559 (eval 15):1) v:{
221 # m <$> gv(*getkey) s/EARLYCV
222 # n <1> entersub[t4] sKS/TARG,1
223 # o <2> helem sKRM*/2
224 # p <2> sassign vKS/2
227 # t <2> leaveloop K/2
228 # u <2> leaveloop K/2
229 # v <1> leavesub[1 ref] K/REFC,1
235 # chunk: #%hash = map { "\L$_", 1 } @array; # perl guesses EXPR. wrong
236 %hash = map { +"\L$_", 1 } @array; # perl guesses BLOCK. right
240 checkOptree(note => q{},
242 code => q{%hash = map { +"\L$_", 1 } @array; },
243 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
244 # 1 <;> nextstate(main 476 (eval 10):1) v
248 # 5 <1> rv2av[t7] lKM/1
250 # 7 <|> mapwhile(other->8)[t9] lK
254 # b <@> stringify[t5] sK/1
255 # c <$> const[IV 1] s
261 # g <1> rv2hv[t2] lKRM*/1
262 # h <2> aassign[t10] KS/COMMON
263 # i <1> leavesub[1 ref] K/REFC,1
265 # 1 <;> nextstate(main 560 (eval 15):1) v
269 # 5 <1> rv2av[t4] lKM/1
271 # 7 <|> mapwhile(other->8)[t5] lK
275 # b <@> stringify[t3] sK/1
276 # c <$> const(IV 1) s
282 # g <1> rv2hv[t1] lKRM*/1
283 # h <2> aassign[t6] KS/COMMON
284 # i <1> leavesub[1 ref] K/REFC,1
290 # chunk: %hash = map { ("\L$_", 1) } @array; # this also works
294 checkOptree(note => q{},
296 code => q{%hash = map { ("\L$_", 1) } @array; },
297 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
298 # 1 <;> nextstate(main 476 (eval 10):1) v
302 # 5 <1> rv2av[t7] lKM/1
304 # 7 <|> mapwhile(other->8)[t9] lK
308 # b <@> stringify[t5] sK/1
309 # c <$> const[IV 1] s
315 # g <1> rv2hv[t2] lKRM*/1
316 # h <2> aassign[t10] KS/COMMON
317 # i <1> leavesub[1 ref] K/REFC,1
319 # 1 <;> nextstate(main 560 (eval 15):1) v
323 # 5 <1> rv2av[t4] lKM/1
325 # 7 <|> mapwhile(other->8)[t5] lK
329 # b <@> stringify[t3] sK/1
330 # c <$> const(IV 1) s
336 # g <1> rv2hv[t1] lKRM*/1
337 # h <2> aassign[t6] KS/COMMON
338 # i <1> leavesub[1 ref] K/REFC,1
344 # chunk: %hash = map { lc($_), 1 } @array; # as does this.
348 checkOptree(note => q{},
350 code => q{%hash = map { lc($_), 1 } @array; },
351 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
352 # 1 <;> nextstate(main 476 (eval 10):1) v
356 # 5 <1> rv2av[t6] lKM/1
358 # 7 <|> mapwhile(other->8)[t8] lK
362 # b <$> const[IV 1] s
368 # f <1> rv2hv[t2] lKRM*/1
369 # g <2> aassign[t9] KS/COMMON
370 # h <1> leavesub[1 ref] K/REFC,1
372 # 1 <;> nextstate(main 589 (eval 26):1) v
376 # 5 <1> rv2av[t3] lKM/1
378 # 7 <|> mapwhile(other->8)[t4] lK
382 # b <$> const(IV 1) s
388 # f <1> rv2hv[t1] lKRM*/1
389 # g <2> aassign[t5] KS/COMMON
390 # h <1> leavesub[1 ref] K/REFC,1
396 # chunk: %hash = map +( lc($_), 1 ), @array; # this is EXPR and works!
400 checkOptree(note => q{},
402 code => q{%hash = map +( lc($_), 1 ), @array; },
403 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
404 # 1 <;> nextstate(main 475 (eval 10):1) v
408 # 5 <1> rv2av[t6] lKM/1
410 # 7 <|> mapwhile(other->8)[t7] lK
414 # b <$> const[IV 1] s
419 # f <1> rv2hv[t2] lKRM*/1
420 # g <2> aassign[t8] KS/COMMON
421 # h <1> leavesub[1 ref] K/REFC,1
423 # 1 <;> nextstate(main 593 (eval 28):1) v
427 # 5 <1> rv2av[t3] lKM/1
429 # 7 <|> mapwhile(other->8)[t4] lK
433 # b <$> const(IV 1) s
438 # f <1> rv2hv[t1] lKRM*/1
439 # g <2> aassign[t5] KS/COMMON
440 # h <1> leavesub[1 ref] K/REFC,1
446 # chunk: %hash = map ( lc($_), 1 ), @array; # evaluates to (1, @array)
450 checkOptree(note => q{},
452 code => q{%hash = map ( lc($_), 1 ), @array; },
453 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
454 # 1 <;> nextstate(main 475 (eval 10):1) v
458 # 5 <$> const[IV 1] sM
460 # 7 <|> mapwhile(other->8)[t5] lK
466 # c <1> rv2hv[t2] lKRM*/1
467 # d <2> aassign[t6] KS/COMMON
469 # f <1> rv2av[t8] K/1
471 # h <1> leavesub[1 ref] K/REFC,1
473 # 1 <;> nextstate(main 597 (eval 30):1) v
477 # 5 <$> const(IV 1) sM
479 # 7 <|> mapwhile(other->8)[t3] lK
485 # c <1> rv2hv[t1] lKRM*/1
486 # d <2> aassign[t4] KS/COMMON
488 # f <1> rv2av[t5] K/1
490 # h <1> leavesub[1 ref] K/REFC,1
496 # chunk: @hashes = map +{ lc($_), 1 }, @array # EXPR, so needs , at end
500 checkOptree(note => q{},
502 code => q{@hashes = map +{ lc($_), 1 }, @array },
503 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
504 # 1 <;> nextstate(main 475 (eval 10):1) v
508 # 5 <1> rv2av[t6] lKM/1
510 # 7 <|> mapwhile(other->8)[t7] lK
514 # b <$> const[IV 1] s
515 # c <@> anonhash sK*/1
518 # e <#> gv[*hashes] s
519 # f <1> rv2av[t2] lKRM*/1
520 # g <2> aassign[t8] KS/COMMON
521 # h <1> leavesub[1 ref] K/REFC,1
523 # 1 <;> nextstate(main 601 (eval 32):1) v
527 # 5 <1> rv2av[t3] lKM/1
529 # 7 <|> mapwhile(other->8)[t4] lK
533 # b <$> const(IV 1) s
534 # c <@> anonhash sK*/1
537 # e <$> gv(*hashes) s
538 # f <1> rv2av[t1] lKRM*/1
539 # g <2> aassign[t5] KS/COMMON
540 # h <1> leavesub[1 ref] K/REFC,1