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 # require 'test.pl'; # now done by OptreeCheck
22 skip "no perlio in this build", 20 unless $Config::Config{useperlio};
24 pass("GENERAL OPTREE EXAMPLES");
26 pass("IF,THEN,ELSE, ?:");
28 checkOptree ( name => '-basic sub {if shift print then,else}',
30 code => sub { if (shift) { print "then" }
33 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
34 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
35 # - <@> lineseq KP ->9
36 # 1 <;> nextstate(main 426 optree.t:16) v ->2
38 # 5 <|> cond_expr(other->6) K/1 ->a
39 # 4 <1> shift sK/1 ->5
40 # 3 <1> rv2av[t2] sKRM/1 ->4
43 # - <0> ex-nextstate v ->6
45 # 6 <0> pushmark s ->7
46 # 7 <$> const[PV "then"] s ->8
49 # b <;> nextstate(main 424 optree.t:17) v ->c
51 # c <0> pushmark s ->d
52 # d <$> const[PV "else"] s ->e
54 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
55 # - <@> lineseq KP ->9
56 # 1 <;> nextstate(main 427 optree_samples.t:18) v ->2
58 # 5 <|> cond_expr(other->6) K/1 ->a
59 # 4 <1> shift sK/1 ->5
60 # 3 <1> rv2av[t1] sKRM/1 ->4
63 # - <0> ex-nextstate v ->6
65 # 6 <0> pushmark s ->7
66 # 7 <$> const(PV "then") s ->8
69 # b <;> nextstate(main 425 optree_samples.t:19) v ->c
71 # c <0> pushmark s ->d
72 # d <$> const(PV "else") s ->e
75 checkOptree ( name => '-basic (see above, with my $a = shift)',
77 code => sub { my $a = shift;
78 if ($a) { print "foo" }
81 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
82 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
83 # - <@> lineseq KP ->d
84 # 1 <;> nextstate(main 431 optree.t:68) v ->2
85 # 6 <2> sassign vKS/2 ->7
86 # 4 <1> shift sK/1 ->5
87 # 3 <1> rv2av[t3] sKRM/1 ->4
89 # 5 <0> padsv[$a:431,435] sRM*/LVINTRO ->6
90 # 7 <;> nextstate(main 435 optree.t:69) v ->8
92 # 9 <|> cond_expr(other->a) K/1 ->e
93 # 8 <0> padsv[$a:431,435] s ->9
95 # - <0> ex-nextstate v ->a
97 # a <0> pushmark s ->b
98 # b <$> const[PV "foo"] s ->c
101 # f <;> nextstate(main 433 optree.t:70) v ->g
103 # g <0> pushmark s ->h
104 # h <$> const[PV "bar"] s ->i
106 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
107 # - <@> lineseq KP ->d
108 # 1 <;> nextstate(main 428 optree_samples.t:48) v ->2
109 # 6 <2> sassign vKS/2 ->7
110 # 4 <1> shift sK/1 ->5
111 # 3 <1> rv2av[t2] sKRM/1 ->4
113 # 5 <0> padsv[$a:428,432] sRM*/LVINTRO ->6
114 # 7 <;> nextstate(main 432 optree_samples.t:49) v ->8
116 # 9 <|> cond_expr(other->a) K/1 ->e
117 # 8 <0> padsv[$a:428,432] s ->9
119 # - <0> ex-nextstate v ->a
121 # a <0> pushmark s ->b
122 # b <$> const(PV "foo") s ->c
125 # f <;> nextstate(main 430 optree_samples.t:50) v ->g
127 # g <0> pushmark s ->h
128 # h <$> const(PV "bar") s ->i
131 checkOptree ( name => '-exec sub {if shift print then,else}',
133 code => sub { if (shift) { print "then" }
134 else { print "else" }
136 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
137 # 1 <;> nextstate(main 426 optree.t:16) v
139 # 3 <1> rv2av[t2] sKRM/1
141 # 5 <|> cond_expr(other->6) K/1
143 # 7 <$> const[PV "then"] s
147 # b <;> nextstate(main 424 optree.t:17) v
149 # d <$> const[PV "else"] s
152 # 9 <1> leavesub[1 ref] K/REFC,1
154 # 1 <;> nextstate(main 436 optree_samples.t:123) v
156 # 3 <1> rv2av[t1] sKRM/1
158 # 5 <|> cond_expr(other->6) K/1
160 # 7 <$> const(PV "then") s
164 # b <;> nextstate(main 434 optree_samples.t:124) v
166 # d <$> const(PV "else") s
169 # 9 <1> leavesub[1 ref] K/REFC,1
172 checkOptree ( name => '-exec (see above, with my $a = shift)',
174 code => sub { my $a = shift;
175 if ($a) { print "foo" }
178 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
179 # 1 <;> nextstate(main 423 optree.t:16) v
181 # 3 <1> rv2av[t3] sKRM/1
183 # 5 <0> padsv[$a:423,427] sRM*/LVINTRO
184 # 6 <2> sassign vKS/2
185 # 7 <;> nextstate(main 427 optree.t:17) v
186 # 8 <0> padsv[$a:423,427] s
187 # 9 <|> cond_expr(other->a) K/1
189 # b <$> const[PV "foo"] s
193 # f <;> nextstate(main 425 optree.t:18) v
195 # h <$> const[PV "bar"] s
198 # d <1> leavesub[1 ref] K/REFC,1
200 # 1 <;> nextstate(main 437 optree_samples.t:112) v
202 # 3 <1> rv2av[t2] sKRM/1
204 # 5 <0> padsv[$a:437,441] sRM*/LVINTRO
205 # 6 <2> sassign vKS/2
206 # 7 <;> nextstate(main 441 optree_samples.t:113) v
207 # 8 <0> padsv[$a:437,441] s
208 # 9 <|> cond_expr(other->a) K/1
210 # b <$> const(PV "foo") s
214 # f <;> nextstate(main 439 optree_samples.t:114) v
216 # h <$> const(PV "bar") s
219 # d <1> leavesub[1 ref] K/REFC,1
222 checkOptree ( name => '-exec sub { print (shift) ? "foo" : "bar" }',
223 code => sub { print (shift) ? "foo" : "bar" },
225 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
226 # 1 <;> nextstate(main 428 optree.t:31) v
229 # 4 <1> rv2av[t2] sKRM/1
232 # 7 <|> cond_expr(other->8) K/1
233 # 8 <$> const[PV "foo"] s
235 # a <$> const[PV "bar"] s
236 # 9 <1> leavesub[1 ref] K/REFC,1
238 # 1 <;> nextstate(main 442 optree_samples.t:144) v
241 # 4 <1> rv2av[t1] sKRM/1
244 # 7 <|> cond_expr(other->8) K/1
245 # 8 <$> const(PV "foo") s
247 # a <$> const(PV "bar") s
248 # 9 <1> leavesub[1 ref] K/REFC,1
253 checkOptree ( name => '-exec sub { foreach (1..10) {print "foo $_"} }',
254 code => sub { foreach (1..10) {print "foo $_"} },
256 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
257 # 1 <;> nextstate(main 443 optree.t:158) v
259 # 3 <$> const[IV 1] s
260 # 4 <$> const[IV 10] s
262 # 6 <{> enteriter(next->d last->g redo->7) lKS/8
264 # f <|> and(other->7) K/1
265 # 7 <;> nextstate(main 442 optree.t:158) v
267 # 9 <$> const[PV "foo "] s
269 # b <2> concat[t4] sK/2
273 # g <2> leaveloop K/2
274 # h <1> leavesub[1 ref] K/REFC,1
276 # 1 <;> nextstate(main 444 optree_samples.t:182) v
278 # 3 <$> const(IV 1) s
279 # 4 <$> const(IV 10) s
281 # 6 <{> enteriter(next->d last->g redo->7) lKS/8
283 # f <|> and(other->7) K/1
284 # 7 <;> nextstate(main 443 optree_samples.t:182) v
286 # 9 <$> const(PV "foo ") s
288 # b <2> concat[t3] sK/2
292 # g <2> leaveloop K/2
293 # h <1> leavesub[1 ref] K/REFC,1
296 checkOptree ( name => '-basic sub { print "foo $_" foreach (1..10) }',
297 code => sub { print "foo $_" foreach (1..10) },
299 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
300 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
301 # - <@> lineseq KP ->h
302 # 1 <;> nextstate(main 445 optree.t:167) v ->2
303 # 2 <;> nextstate(main 445 optree.t:167) v ->3
304 # g <2> leaveloop K/2 ->h
305 # 7 <{> enteriter(next->d last->g redo->8) lKS/8 ->e
306 # - <0> ex-pushmark s ->3
307 # - <1> ex-list lK ->6
308 # 3 <0> pushmark s ->4
309 # 4 <$> const[IV 1] s ->5
310 # 5 <$> const[IV 10] s ->6
313 # f <|> and(other->8) K/1 ->g
315 # - <@> lineseq sK ->-
317 # 8 <0> pushmark s ->9
318 # - <1> ex-stringify sK/1 ->c
319 # - <0> ex-pushmark s ->9
320 # b <2> concat[t2] sK/2 ->c
321 # 9 <$> const[PV "foo "] s ->a
322 # - <1> ex-rv2sv sK/1 ->b
323 # a <#> gvsv[*_] s ->b
324 # d <0> unstack s ->e
326 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
327 # - <@> lineseq KP ->h
328 # 1 <;> nextstate(main 446 optree_samples.t:192) v ->2
329 # 2 <;> nextstate(main 446 optree_samples.t:192) v ->3
330 # g <2> leaveloop K/2 ->h
331 # 7 <{> enteriter(next->d last->g redo->8) lKS/8 ->e
332 # - <0> ex-pushmark s ->3
333 # - <1> ex-list lK ->6
334 # 3 <0> pushmark s ->4
335 # 4 <$> const(IV 1) s ->5
336 # 5 <$> const(IV 10) s ->6
339 # f <|> and(other->8) K/1 ->g
341 # - <@> lineseq sK ->-
343 # 8 <0> pushmark s ->9
344 # - <1> ex-stringify sK/1 ->c
345 # - <0> ex-pushmark s ->9
346 # b <2> concat[t1] sK/2 ->c
347 # 9 <$> const(PV "foo ") s ->a
348 # - <1> ex-rv2sv sK/1 ->b
349 # a <$> gvsv(*_) s ->b
350 # d <0> unstack s ->e
353 checkOptree ( name => '-exec -e foreach (1..10) {print qq{foo $_}}',
354 prog => 'foreach (1..10) {print qq{foo $_}}',
356 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
358 # 2 <;> nextstate(main 2 -e:1) v
360 # 4 <$> const[IV 1] s
361 # 5 <$> const[IV 10] s
363 # 7 <{> enteriter(next->e last->h redo->8) lKS/8
365 # g <|> and(other->8) vK/1
366 # 8 <;> nextstate(main 1 -e:1) v
368 # a <$> const[PV "foo "] s
370 # c <2> concat[t4] sK/2
374 # h <2> leaveloop vK/2
375 # i <@> leave[1 ref] vKP/REFC
378 # 2 <;> nextstate(main 2 -e:1) v
380 # 4 <$> const(IV 1) s
381 # 5 <$> const(IV 10) s
383 # 7 <{> enteriter(next->e last->h redo->8) lKS/8
385 # g <|> and(other->8) vK/1
386 # 8 <;> nextstate(main 1 -e:1) v
388 # a <$> const(PV "foo ") s
390 # c <2> concat[t3] sK/2
394 # h <2> leaveloop vK/2
395 # i <@> leave[1 ref] vKP/REFC
398 checkOptree ( name => '-exec sub { print "foo $_" foreach (1..10) }',
399 code => sub { print "foo $_" foreach (1..10) },
401 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
402 # 1 <;> nextstate(main 445 optree.t:167) v
403 # 2 <;> nextstate(main 445 optree.t:167) v
405 # 4 <$> const[IV 1] s
406 # 5 <$> const[IV 10] s
408 # 7 <{> enteriter(next->d last->g redo->8) lKS/8
410 # f <|> and(other->8) K/1
412 # 9 <$> const[PV "foo "] s
414 # b <2> concat[t2] sK/2
418 # g <2> leaveloop K/2
419 # h <1> leavesub[1 ref] K/REFC,1
421 # 1 <;> nextstate(main 447 optree_samples.t:252) v
422 # 2 <;> nextstate(main 447 optree_samples.t:252) v
424 # 4 <$> const(IV 1) s
425 # 5 <$> const(IV 10) s
427 # 7 <{> enteriter(next->d last->g redo->8) lKS/8
429 # f <|> and(other->8) K/1
431 # 9 <$> const(PV "foo ") s
433 # b <2> concat[t1] sK/2
437 # g <2> leaveloop K/2
438 # h <1> leavesub[1 ref] K/REFC,1
441 pass("GREP: SAMPLES FROM PERLDOC -F GREP");
443 checkOptree ( name => '@foo = grep(!/^\#/, @bar)',
444 code => '@foo = grep(!/^\#/, @bar)',
446 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
447 # 1 <;> nextstate(main 496 (eval 20):1) v:{
451 # 5 <1> rv2av[t4] lKM/1
453 # 7 <|> grepwhile(other->8)[t5] lK
454 # 8 </> match(/"^#"/) s/RTIME
459 # c <1> rv2av[t2] lKRM*/1
460 # d <2> aassign[t6] KS/COMMON
461 # e <1> leavesub[1 ref] K/REFC,1
463 # 1 <;> nextstate(main 496 (eval 20):1) v:{
467 # 5 <1> rv2av[t2] lKM/1
469 # 7 <|> grepwhile(other->8)[t3] lK
470 # 8 </> match(/"^\\#"/) s/RTIME
475 # c <1> rv2av[t1] lKRM*/1
476 # d <2> aassign[t4] KS/COMMON
477 # e <1> leavesub[1 ref] K/REFC,1
481 pass("MAP: SAMPLES FROM PERLDOC -F MAP");
483 checkOptree ( name => '%h = map { getkey($_) => $_ } @a',
484 code => '%h = map { getkey($_) => $_ } @a',
486 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
487 # 1 <;> nextstate(main 501 (eval 22):1) v:{
491 # 5 <1> rv2av[t8] lKM/1
493 # 7 <|> mapwhile(other->8)[t9] lK
495 # 9 <;> nextstate(main 500 (eval 22):1) v:{
499 # d <#> gv[*getkey] s/EARLYCV
500 # e <1> entersub[t5] lKS/TARG,1
507 # k <1> rv2hv[t2] lKRM*/1
508 # l <2> aassign[t10] KS/COMMON
509 # m <1> leavesub[1 ref] K/REFC,1
511 # 1 <;> nextstate(main 501 (eval 22):1) v:{
515 # 5 <1> rv2av[t3] lKM/1
517 # 7 <|> mapwhile(other->8)[t4] lK
519 # 9 <;> nextstate(main 500 (eval 22):1) v:{
523 # d <$> gv(*getkey) s/EARLYCV
524 # e <1> entersub[t2] lKS/TARG,1
531 # k <1> rv2hv[t1] lKRM*/1
532 # l <2> aassign[t5] KS/COMMON
533 # m <1> leavesub[1 ref] K/REFC,1
536 checkOptree ( name => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
537 code => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
539 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
540 # 1 <;> nextstate(main 505 (eval 24):1) v
544 # 5 <1> rv2hv[t2] lKRM*/1
545 # 6 <2> aassign[t3] vKS
546 # 7 <;> nextstate(main 506 (eval 24):1) v:{
549 # a <1> rv2av[t6] sKRM/1
552 # d <{> enteriter(next->o last->r redo->e) lKS/8
554 # q <|> and(other->e) K/1
555 # e <;> nextstate(main 505 (eval 24):1) v:{
561 # k <#> gv[*getkey] s/EARLYCV
562 # l <1> entersub[t10] sKS/TARG,1
563 # m <2> helem sKRM*/2
564 # n <2> sassign vKS/2
567 # r <2> leaveloop K/2
568 # s <1> leavesub[1 ref] K/REFC,1
570 # 1 <;> nextstate(main 505 (eval 24):1) v
574 # 5 <1> rv2hv[t1] lKRM*/1
575 # 6 <2> aassign[t2] vKS
576 # 7 <;> nextstate(main 506 (eval 24):1) v:{
579 # a <1> rv2av[t3] sKRM/1
582 # d <{> enteriter(next->o last->r redo->e) lKS/8
584 # q <|> and(other->e) K/1
585 # e <;> nextstate(main 505 (eval 24):1) v:{
591 # k <$> gv(*getkey) s/EARLYCV
592 # l <1> entersub[t4] sKS/TARG,1
593 # m <2> helem sKRM*/2
594 # n <2> sassign vKS/2
597 # r <2> leaveloop K/2
598 # s <1> leavesub[1 ref] K/REFC,1
601 checkOptree ( name => 'map $_+42, 10..20',
602 code => 'map $_+42, 10..20',
604 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
605 # 1 <;> nextstate(main 497 (eval 20):1) v
610 # 6 <|> mapwhile(other->7)[t5] K
612 # 8 <$> const[IV 42] s
615 # a <1> leavesub[1 ref] K/REFC,1
617 # 1 <;> nextstate(main 511 (eval 26):1) v
622 # 6 <|> mapwhile(other->7)[t4] K
624 # 8 <$> const(IV 42) s
627 # a <1> leavesub[1 ref] K/REFC,1
632 checkOptree ( name => '-e use constant j => qq{junk}; print j',
633 prog => 'use constant j => qq{junk}; print j',
635 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
637 # 2 <;> nextstate(main 71 -e:1) v:{
639 # 4 <$> const[PV "junk"] s
641 # 6 <@> leave[1 ref] vKP/REFC
644 # 2 <;> nextstate(main 71 -e:1) v:{
646 # 4 <$> const(PV "junk") s
648 # 6 <@> leave[1 ref] vKP/REFC
655 #######################################################################
657 checkOptree ( name => '-exec sub a { print (shift) ? "foo" : "bar" }',
658 code => sub { print (shift) ? "foo" : "bar" },
660 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
661 insert threaded reference here
663 insert non-threaded reference here