5 @INC = ('../lib', '../ext/B/t');
7 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
8 print "1..0 # Skip -- Perl configured without B module\n";
17 skip "no perlio in this build", 20 unless $Config::Config{useperlio};
19 pass("GENERAL OPTREE EXAMPLES");
21 pass("IF,THEN,ELSE, ?:");
23 checkOptree ( name => '-basic sub {if shift print then,else}',
25 code => sub { if (shift) { print "then" }
28 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
29 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
30 # - <@> lineseq KP ->9
31 # 1 <;> nextstate(main 426 optree.t:16) v ->2
33 # 5 <|> cond_expr(other->6) K/1 ->a
34 # 4 <1> shift sK/1 ->5
35 # 3 <1> rv2av[t2] sKRM/1 ->4
38 # - <0> ex-nextstate v ->6
40 # 6 <0> pushmark s ->7
41 # 7 <$> const[PV "then"] s ->8
44 # b <;> nextstate(main 424 optree.t:17) v ->c
46 # c <0> pushmark s ->d
47 # d <$> const[PV "else"] s ->e
49 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
50 # - <@> lineseq KP ->9
51 # 1 <;> nextstate(main 427 optree_samples.t:18) v ->2
53 # 5 <|> cond_expr(other->6) K/1 ->a
54 # 4 <1> shift sK/1 ->5
55 # 3 <1> rv2av[t1] sKRM/1 ->4
58 # - <0> ex-nextstate v ->6
60 # 6 <0> pushmark s ->7
61 # 7 <$> const(PV "then") s ->8
64 # b <;> nextstate(main 425 optree_samples.t:19) v ->c
66 # c <0> pushmark s ->d
67 # d <$> const(PV "else") s ->e
70 checkOptree ( name => '-basic (see above, with my $a = shift)',
72 code => sub { my $a = shift;
73 if ($a) { print "foo" }
76 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
77 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
78 # - <@> lineseq KP ->d
79 # 1 <;> nextstate(main 431 optree.t:68) v ->2
80 # 6 <2> sassign vKS/2 ->7
81 # 4 <1> shift sK/1 ->5
82 # 3 <1> rv2av[t3] sKRM/1 ->4
84 # 5 <0> padsv[$a:431,435] sRM*/LVINTRO ->6
85 # 7 <;> nextstate(main 435 optree.t:69) v ->8
87 # 9 <|> cond_expr(other->a) K/1 ->e
88 # 8 <0> padsv[$a:431,435] s ->9
90 # - <0> ex-nextstate v ->a
92 # a <0> pushmark s ->b
93 # b <$> const[PV "foo"] s ->c
96 # f <;> nextstate(main 433 optree.t:70) v ->g
98 # g <0> pushmark s ->h
99 # h <$> const[PV "bar"] s ->i
101 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
102 # - <@> lineseq KP ->d
103 # 1 <;> nextstate(main 428 optree_samples.t:48) v ->2
104 # 6 <2> sassign vKS/2 ->7
105 # 4 <1> shift sK/1 ->5
106 # 3 <1> rv2av[t2] sKRM/1 ->4
108 # 5 <0> padsv[$a:428,432] sRM*/LVINTRO ->6
109 # 7 <;> nextstate(main 432 optree_samples.t:49) v ->8
111 # 9 <|> cond_expr(other->a) K/1 ->e
112 # 8 <0> padsv[$a:428,432] s ->9
114 # - <0> ex-nextstate v ->a
116 # a <0> pushmark s ->b
117 # b <$> const(PV "foo") s ->c
120 # f <;> nextstate(main 430 optree_samples.t:50) v ->g
122 # g <0> pushmark s ->h
123 # h <$> const(PV "bar") s ->i
126 checkOptree ( name => '-exec sub {if shift print then,else}',
128 code => sub { if (shift) { print "then" }
129 else { print "else" }
131 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
132 # 1 <;> nextstate(main 426 optree.t:16) v
134 # 3 <1> rv2av[t2] sKRM/1
136 # 5 <|> cond_expr(other->6) K/1
138 # 7 <$> const[PV "then"] s
142 # b <;> nextstate(main 424 optree.t:17) v
144 # d <$> const[PV "else"] s
147 # 9 <1> leavesub[1 ref] K/REFC,1
149 # 1 <;> nextstate(main 436 optree_samples.t:123) v
151 # 3 <1> rv2av[t1] sKRM/1
153 # 5 <|> cond_expr(other->6) K/1
155 # 7 <$> const(PV "then") s
159 # b <;> nextstate(main 434 optree_samples.t:124) v
161 # d <$> const(PV "else") s
164 # 9 <1> leavesub[1 ref] K/REFC,1
167 checkOptree ( name => '-exec (see above, with my $a = shift)',
169 code => sub { my $a = shift;
170 if ($a) { print "foo" }
173 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
174 # 1 <;> nextstate(main 423 optree.t:16) v
176 # 3 <1> rv2av[t3] sKRM/1
178 # 5 <0> padsv[$a:423,427] sRM*/LVINTRO
179 # 6 <2> sassign vKS/2
180 # 7 <;> nextstate(main 427 optree.t:17) v
181 # 8 <0> padsv[$a:423,427] s
182 # 9 <|> cond_expr(other->a) K/1
184 # b <$> const[PV "foo"] s
188 # f <;> nextstate(main 425 optree.t:18) v
190 # h <$> const[PV "bar"] s
193 # d <1> leavesub[1 ref] K/REFC,1
195 # 1 <;> nextstate(main 437 optree_samples.t:112) v
197 # 3 <1> rv2av[t2] sKRM/1
199 # 5 <0> padsv[$a:437,441] sRM*/LVINTRO
200 # 6 <2> sassign vKS/2
201 # 7 <;> nextstate(main 441 optree_samples.t:113) v
202 # 8 <0> padsv[$a:437,441] s
203 # 9 <|> cond_expr(other->a) K/1
205 # b <$> const(PV "foo") s
209 # f <;> nextstate(main 439 optree_samples.t:114) v
211 # h <$> const(PV "bar") s
214 # d <1> leavesub[1 ref] K/REFC,1
217 checkOptree ( name => '-exec sub { print (shift) ? "foo" : "bar" }',
218 code => sub { print (shift) ? "foo" : "bar" },
220 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
221 # 1 <;> nextstate(main 428 optree.t:31) v
224 # 4 <1> rv2av[t2] sKRM/1
227 # 7 <|> cond_expr(other->8) K/1
228 # 8 <$> const[PV "foo"] s
230 # a <$> const[PV "bar"] s
231 # 9 <1> leavesub[1 ref] K/REFC,1
233 # 1 <;> nextstate(main 442 optree_samples.t:144) v
236 # 4 <1> rv2av[t1] sKRM/1
239 # 7 <|> cond_expr(other->8) K/1
240 # 8 <$> const(PV "foo") s
242 # a <$> const(PV "bar") s
243 # 9 <1> leavesub[1 ref] K/REFC,1
248 checkOptree ( name => '-exec sub { foreach (1..10) {print "foo $_"} }',
249 code => sub { foreach (1..10) {print "foo $_"} },
251 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
252 # 1 <;> nextstate(main 443 optree.t:158) v
254 # 3 <$> const[IV 1] s
255 # 4 <$> const[IV 10] s
257 # 6 <{> enteriter(next->d last->g redo->7) lKS
259 # f <|> and(other->7) K/1
260 # 7 <;> nextstate(main 442 optree.t:158) v
262 # 9 <$> const[PV "foo "] s
264 # b <2> concat[t4] sK/2
268 # g <2> leaveloop K/2
269 # h <1> leavesub[1 ref] K/REFC,1
271 # 1 <;> nextstate(main 444 optree_samples.t:182) v
273 # 3 <$> const(IV 1) s
274 # 4 <$> const(IV 10) s
276 # 6 <{> enteriter(next->d last->g redo->7) lKS
278 # f <|> and(other->7) K/1
279 # 7 <;> nextstate(main 443 optree_samples.t:182) v
281 # 9 <$> const(PV "foo ") s
283 # b <2> concat[t3] sK/2
287 # g <2> leaveloop K/2
288 # h <1> leavesub[1 ref] K/REFC,1
291 checkOptree ( name => '-basic sub { print "foo $_" foreach (1..10) }',
292 code => sub { print "foo $_" foreach (1..10) },
294 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
295 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
296 # - <@> lineseq KP ->h
297 # 1 <;> nextstate(main 445 optree.t:167) v ->2
298 # 2 <;> nextstate(main 445 optree.t:167) v ->3
299 # g <2> leaveloop K/2 ->h
300 # 7 <{> enteriter(next->d last->g redo->8) lKS ->e
301 # - <0> ex-pushmark s ->3
302 # - <1> ex-list lK ->6
303 # 3 <0> pushmark s ->4
304 # 4 <$> const[IV 1] s ->5
305 # 5 <$> const[IV 10] s ->6
308 # f <|> and(other->8) K/1 ->g
310 # - <@> lineseq sK ->-
312 # 8 <0> pushmark s ->9
313 # - <1> ex-stringify sK/1 ->c
314 # - <0> ex-pushmark s ->9
315 # b <2> concat[t2] sK/2 ->c
316 # 9 <$> const[PV "foo "] s ->a
317 # - <1> ex-rv2sv sK/1 ->b
318 # a <#> gvsv[*_] s ->b
319 # d <0> unstack s ->e
321 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
322 # - <@> lineseq KP ->h
323 # 1 <;> nextstate(main 446 optree_samples.t:192) v ->2
324 # 2 <;> nextstate(main 446 optree_samples.t:192) v ->3
325 # g <2> leaveloop K/2 ->h
326 # 7 <{> enteriter(next->d last->g redo->8) lKS ->e
327 # - <0> ex-pushmark s ->3
328 # - <1> ex-list lK ->6
329 # 3 <0> pushmark s ->4
330 # 4 <$> const(IV 1) s ->5
331 # 5 <$> const(IV 10) s ->6
334 # f <|> and(other->8) K/1 ->g
336 # - <@> lineseq sK ->-
338 # 8 <0> pushmark s ->9
339 # - <1> ex-stringify sK/1 ->c
340 # - <0> ex-pushmark s ->9
341 # b <2> concat[t1] sK/2 ->c
342 # 9 <$> const(PV "foo ") s ->a
343 # - <1> ex-rv2sv sK/1 ->b
344 # a <$> gvsv(*_) s ->b
345 # d <0> unstack s ->e
348 checkOptree ( name => '-exec -e foreach (1..10) {print qq{foo $_}}',
349 prog => 'foreach (1..10) {print qq{foo $_}}',
351 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
353 # 2 <;> nextstate(main 2 -e:1) v
355 # 4 <$> const[IV 1] s
356 # 5 <$> const[IV 10] s
358 # 7 <{> enteriter(next->e last->h redo->8) lKS
360 # g <|> and(other->8) vK/1
361 # 8 <;> nextstate(main 1 -e:1) v
363 # a <$> const[PV "foo "] s
365 # c <2> concat[t4] sK/2
369 # h <2> leaveloop vK/2
370 # i <@> leave[1 ref] vKP/REFC
373 # 2 <;> nextstate(main 2 -e:1) v
375 # 4 <$> const(IV 1) s
376 # 5 <$> const(IV 10) s
378 # 7 <{> enteriter(next->e last->h redo->8) lKS
380 # g <|> and(other->8) vK/1
381 # 8 <;> nextstate(main 1 -e:1) v
383 # a <$> const(PV "foo ") s
385 # c <2> concat[t3] sK/2
389 # h <2> leaveloop vK/2
390 # i <@> leave[1 ref] vKP/REFC
393 checkOptree ( name => '-exec sub { print "foo $_" foreach (1..10) }',
394 code => sub { print "foo $_" foreach (1..10) },
396 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
397 # 1 <;> nextstate(main 445 optree.t:167) v
398 # 2 <;> nextstate(main 445 optree.t:167) v
400 # 4 <$> const[IV 1] s
401 # 5 <$> const[IV 10] s
403 # 7 <{> enteriter(next->d last->g redo->8) lKS
405 # f <|> and(other->8) K/1
407 # 9 <$> const[PV "foo "] s
409 # b <2> concat[t2] sK/2
413 # g <2> leaveloop K/2
414 # h <1> leavesub[1 ref] K/REFC,1
416 # 1 <;> nextstate(main 447 optree_samples.t:252) v
417 # 2 <;> nextstate(main 447 optree_samples.t:252) v
419 # 4 <$> const(IV 1) s
420 # 5 <$> const(IV 10) s
422 # 7 <{> enteriter(next->d last->g redo->8) lKS
424 # f <|> and(other->8) K/1
426 # 9 <$> const(PV "foo ") s
428 # b <2> concat[t1] sK/2
432 # g <2> leaveloop K/2
433 # h <1> leavesub[1 ref] K/REFC,1
436 pass("GREP: SAMPLES FROM PERLDOC -F GREP");
438 checkOptree ( name => '@foo = grep(!/^\#/, @bar)',
439 code => '@foo = grep(!/^\#/, @bar)',
441 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
442 # 1 <;> nextstate(main 496 (eval 20):1) v
446 # 5 <1> rv2av[t4] lKM/1
448 # 7 <|> grepwhile(other->8)[t5] lK
449 # 8 </> match(/"^#"/) s/RTIME
454 # c <1> rv2av[t2] lKRM*/1
455 # d <2> aassign[t6] KS/COMMON
456 # e <1> leavesub[1 ref] K/REFC,1
458 # 1 <;> nextstate(main 496 (eval 20):1) v
462 # 5 <1> rv2av[t2] lKM/1
464 # 7 <|> grepwhile(other->8)[t3] lK
465 # 8 </> match(/"^\\#"/) s/RTIME
470 # c <1> rv2av[t1] lKRM*/1
471 # d <2> aassign[t4] KS/COMMON
472 # e <1> leavesub[1 ref] K/REFC,1
476 pass("MAP: SAMPLES FROM PERLDOC -F MAP");
478 checkOptree ( name => '%h = map { getkey($_) => $_ } @a',
479 code => '%h = map { getkey($_) => $_ } @a',
481 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
482 # 1 <;> nextstate(main 501 (eval 22):1) v
486 # 5 <1> rv2av[t8] lKM/1
488 # 7 <|> mapwhile(other->8)[t9] lK
490 # 9 <;> nextstate(main 500 (eval 22):1) v
494 # d <#> gv[*getkey] s/EARLYCV
495 # e <1> entersub[t5] lKS/TARG,1
502 # k <1> rv2hv[t2] lKRM*/1
503 # l <2> aassign[t10] KS/COMMON
504 # m <1> leavesub[1 ref] K/REFC,1
506 # 1 <;> nextstate(main 501 (eval 22):1) v
510 # 5 <1> rv2av[t3] lKM/1
512 # 7 <|> mapwhile(other->8)[t4] lK
514 # 9 <;> nextstate(main 500 (eval 22):1) v
518 # d <$> gv(*getkey) s/EARLYCV
519 # e <1> entersub[t2] lKS/TARG,1
526 # k <1> rv2hv[t1] lKRM*/1
527 # l <2> aassign[t5] KS/COMMON
528 # m <1> leavesub[1 ref] K/REFC,1
531 checkOptree ( name => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
532 code => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
534 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
535 # 1 <;> nextstate(main 505 (eval 24):1) v
539 # 5 <1> rv2hv[t2] lKRM*/1
540 # 6 <2> aassign[t3] vKS
541 # 7 <;> nextstate(main 506 (eval 24):1) v
544 # a <1> rv2av[t6] sKRM/1
547 # d <{> enteriter(next->o last->r redo->e) lKS
549 # q <|> and(other->e) K/1
550 # e <;> nextstate(main 505 (eval 24):1) v
556 # k <#> gv[*getkey] s/EARLYCV
557 # l <1> entersub[t10] sKS/TARG,1
558 # m <2> helem sKRM*/2
559 # n <2> sassign vKS/2
562 # r <2> leaveloop K/2
563 # s <1> leavesub[1 ref] K/REFC,1
565 # 1 <;> nextstate(main 505 (eval 24):1) v
569 # 5 <1> rv2hv[t1] lKRM*/1
570 # 6 <2> aassign[t2] vKS
571 # 7 <;> nextstate(main 506 (eval 24):1) v
574 # a <1> rv2av[t3] sKRM/1
577 # d <{> enteriter(next->o last->r redo->e) lKS
579 # q <|> and(other->e) K/1
580 # e <;> nextstate(main 505 (eval 24):1) v
586 # k <$> gv(*getkey) s/EARLYCV
587 # l <1> entersub[t4] sKS/TARG,1
588 # m <2> helem sKRM*/2
589 # n <2> sassign vKS/2
592 # r <2> leaveloop K/2
593 # s <1> leavesub[1 ref] K/REFC,1
596 checkOptree ( name => 'map $_+42, 10..20',
597 code => 'map $_+42, 10..20',
599 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
600 # 1 <;> nextstate(main 497 (eval 20):1) v
605 # 6 <|> mapwhile(other->7)[t7] K
607 # 8 <$> const[IV 42] s
610 # a <1> leavesub[1 ref] K/REFC,1
612 # 1 <;> nextstate(main 511 (eval 26):1) v
617 # 6 <|> mapwhile(other->7)[t4] K
619 # 8 <$> const(IV 42) s
622 # a <1> leavesub[1 ref] K/REFC,1
627 checkOptree ( name => '-e use constant j => qq{junk}; print j',
628 prog => 'use constant j => qq{junk}; print j',
630 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
632 # 2 <;> nextstate(main 71 -e:1) v
634 # 4 <$> const[PV "junk"] s
636 # 6 <@> leave[1 ref] vKP/REFC
639 # 2 <;> nextstate(main 71 -e:1) v
641 # 4 <$> const(PV "junk") s
643 # 6 <@> leave[1 ref] vKP/REFC
650 #######################################################################
652 checkOptree ( name => '-exec sub a { print (shift) ? "foo" : "bar" }',
653 code => sub { print (shift) ? "foo" : "bar" },
655 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
656 insert threaded reference here
658 insert non-threaded reference here