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, ?:");
30 if (((caller 0)[10]||{})->{open}) {
31 @open_todo = (skip => "\$^OPEN is set");
36 checkOptree ( name => '-basic sub {if shift print then,else}',
38 code => sub { if (shift) { print "then" }
42 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
43 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
44 # - <@> lineseq KP ->9
45 # 1 <;> nextstate(main 426 optree.t:16) v ->2
47 # 5 <|> cond_expr(other->6) K/1 ->a
48 # 4 <1> shift sK/1 ->5
49 # 3 <1> rv2av[t2] sKRM/1 ->4
52 # - <0> ex-nextstate v ->6
54 # 6 <0> pushmark s ->7
55 # 7 <$> const[PV "then"] s ->8
58 # b <;> nextstate(main 424 optree.t:17) v ->c
60 # c <0> pushmark s ->d
61 # d <$> const[PV "else"] s ->e
63 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
64 # - <@> lineseq KP ->9
65 # 1 <;> nextstate(main 427 optree_samples.t:18) v ->2
67 # 5 <|> cond_expr(other->6) K/1 ->a
68 # 4 <1> shift sK/1 ->5
69 # 3 <1> rv2av[t1] sKRM/1 ->4
72 # - <0> ex-nextstate v ->6
74 # 6 <0> pushmark s ->7
75 # 7 <$> const(PV "then") s ->8
78 # b <;> nextstate(main 425 optree_samples.t:19) v ->c
80 # c <0> pushmark s ->d
81 # d <$> const(PV "else") s ->e
84 checkOptree ( name => '-basic (see above, with my $a = shift)',
86 code => sub { my $a = shift;
87 if ($a) { print "foo" }
91 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
92 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
93 # - <@> lineseq KP ->d
94 # 1 <;> nextstate(main 431 optree.t:68) v ->2
95 # 6 <2> sassign vKS/2 ->7
96 # 4 <1> shift sK/1 ->5
97 # 3 <1> rv2av[t3] sKRM/1 ->4
99 # 5 <0> padsv[$a:431,435] sRM*/LVINTRO ->6
100 # 7 <;> nextstate(main 435 optree.t:69) v ->8
102 # 9 <|> cond_expr(other->a) K/1 ->e
103 # 8 <0> padsv[$a:431,435] s ->9
105 # - <0> ex-nextstate v ->a
107 # a <0> pushmark s ->b
108 # b <$> const[PV "foo"] s ->c
111 # f <;> nextstate(main 433 optree.t:70) v ->g
113 # g <0> pushmark s ->h
114 # h <$> const[PV "bar"] s ->i
116 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
117 # - <@> lineseq KP ->d
118 # 1 <;> nextstate(main 428 optree_samples.t:48) v ->2
119 # 6 <2> sassign vKS/2 ->7
120 # 4 <1> shift sK/1 ->5
121 # 3 <1> rv2av[t2] sKRM/1 ->4
123 # 5 <0> padsv[$a:428,432] sRM*/LVINTRO ->6
124 # 7 <;> nextstate(main 432 optree_samples.t:49) v ->8
126 # 9 <|> cond_expr(other->a) K/1 ->e
127 # 8 <0> padsv[$a:428,432] s ->9
129 # - <0> ex-nextstate v ->a
131 # a <0> pushmark s ->b
132 # b <$> const(PV "foo") s ->c
135 # f <;> nextstate(main 430 optree_samples.t:50) v ->g
137 # g <0> pushmark s ->h
138 # h <$> const(PV "bar") s ->i
141 checkOptree ( name => '-exec sub {if shift print then,else}',
143 code => sub { if (shift) { print "then" }
144 else { print "else" }
147 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
148 # 1 <;> nextstate(main 426 optree.t:16) v
150 # 3 <1> rv2av[t2] sKRM/1
152 # 5 <|> cond_expr(other->6) K/1
154 # 7 <$> const[PV "then"] s
158 # b <;> nextstate(main 424 optree.t:17) v
160 # d <$> const[PV "else"] s
163 # 9 <1> leavesub[1 ref] K/REFC,1
165 # 1 <;> nextstate(main 436 optree_samples.t:123) v
167 # 3 <1> rv2av[t1] sKRM/1
169 # 5 <|> cond_expr(other->6) K/1
171 # 7 <$> const(PV "then") s
175 # b <;> nextstate(main 434 optree_samples.t:124) v
177 # d <$> const(PV "else") s
180 # 9 <1> leavesub[1 ref] K/REFC,1
183 checkOptree ( name => '-exec (see above, with my $a = shift)',
185 code => sub { my $a = shift;
186 if ($a) { print "foo" }
190 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
191 # 1 <;> nextstate(main 423 optree.t:16) v
193 # 3 <1> rv2av[t3] sKRM/1
195 # 5 <0> padsv[$a:423,427] sRM*/LVINTRO
196 # 6 <2> sassign vKS/2
197 # 7 <;> nextstate(main 427 optree.t:17) v
198 # 8 <0> padsv[$a:423,427] s
199 # 9 <|> cond_expr(other->a) K/1
201 # b <$> const[PV "foo"] s
205 # f <;> nextstate(main 425 optree.t:18) v
207 # h <$> const[PV "bar"] s
210 # d <1> leavesub[1 ref] K/REFC,1
212 # 1 <;> nextstate(main 437 optree_samples.t:112) v
214 # 3 <1> rv2av[t2] sKRM/1
216 # 5 <0> padsv[$a:437,441] sRM*/LVINTRO
217 # 6 <2> sassign vKS/2
218 # 7 <;> nextstate(main 441 optree_samples.t:113) v
219 # 8 <0> padsv[$a:437,441] s
220 # 9 <|> cond_expr(other->a) K/1
222 # b <$> const(PV "foo") s
226 # f <;> nextstate(main 439 optree_samples.t:114) v
228 # h <$> const(PV "bar") s
231 # d <1> leavesub[1 ref] K/REFC,1
234 checkOptree ( name => '-exec sub { print (shift) ? "foo" : "bar" }',
235 code => sub { print (shift) ? "foo" : "bar" },
238 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
239 # 1 <;> nextstate(main 428 optree.t:31) v
242 # 4 <1> rv2av[t2] sKRM/1
245 # 7 <|> cond_expr(other->8) K/1
246 # 8 <$> const[PV "foo"] s
248 # a <$> const[PV "bar"] s
249 # 9 <1> leavesub[1 ref] K/REFC,1
251 # 1 <;> nextstate(main 442 optree_samples.t:144) v
254 # 4 <1> rv2av[t1] sKRM/1
257 # 7 <|> cond_expr(other->8) K/1
258 # 8 <$> const(PV "foo") s
260 # a <$> const(PV "bar") s
261 # 9 <1> leavesub[1 ref] K/REFC,1
266 checkOptree ( name => '-exec sub { foreach (1..10) {print "foo $_"} }',
267 code => sub { foreach (1..10) {print "foo $_"} },
270 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
271 # 1 <;> nextstate(main 443 optree.t:158) v
273 # 3 <$> const[IV 1] s
274 # 4 <$> const[IV 10] s
276 # 6 <{> enteriter(next->d last->g redo->7) lKS/8
278 # f <|> and(other->7) K/1
279 # 7 <;> nextstate(main 442 optree.t:158) v
281 # 9 <$> const[PV "foo "] s
283 # b <2> concat[t4] sK/2
287 # g <2> leaveloop K/2
288 # h <1> leavesub[1 ref] K/REFC,1
290 # 1 <;> nextstate(main 444 optree_samples.t:182) v
292 # 3 <$> const(IV 1) s
293 # 4 <$> const(IV 10) s
295 # 6 <{> enteriter(next->d last->g redo->7) lKS/8
297 # f <|> and(other->7) K/1
298 # 7 <;> nextstate(main 443 optree_samples.t:182) v
300 # 9 <$> const(PV "foo ") s
302 # b <2> concat[t3] sK/2
306 # g <2> leaveloop K/2
307 # h <1> leavesub[1 ref] K/REFC,1
310 checkOptree ( name => '-basic sub { print "foo $_" foreach (1..10) }',
311 code => sub { print "foo $_" foreach (1..10) },
314 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
315 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
316 # - <@> lineseq KP ->h
317 # 1 <;> nextstate(main 445 optree.t:167) v ->2
318 # 2 <;> nextstate(main 445 optree.t:167) v ->3
319 # g <2> leaveloop K/2 ->h
320 # 7 <{> enteriter(next->d last->g redo->8) lKS/8 ->e
321 # - <0> ex-pushmark s ->3
322 # - <1> ex-list lK ->6
323 # 3 <0> pushmark s ->4
324 # 4 <$> const[IV 1] s ->5
325 # 5 <$> const[IV 10] s ->6
328 # f <|> and(other->8) K/1 ->g
330 # - <@> lineseq sK ->-
332 # 8 <0> pushmark s ->9
333 # - <1> ex-stringify sK/1 ->c
334 # - <0> ex-pushmark s ->9
335 # b <2> concat[t2] sK/2 ->c
336 # 9 <$> const[PV "foo "] s ->a
337 # - <1> ex-rv2sv sK/1 ->b
338 # a <#> gvsv[*_] s ->b
339 # d <0> unstack s ->e
341 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
342 # - <@> lineseq KP ->h
343 # 1 <;> nextstate(main 446 optree_samples.t:192) v ->2
344 # 2 <;> nextstate(main 446 optree_samples.t:192) v ->3
345 # g <2> leaveloop K/2 ->h
346 # 7 <{> enteriter(next->d last->g redo->8) lKS/8 ->e
347 # - <0> ex-pushmark s ->3
348 # - <1> ex-list lK ->6
349 # 3 <0> pushmark s ->4
350 # 4 <$> const(IV 1) s ->5
351 # 5 <$> const(IV 10) s ->6
354 # f <|> and(other->8) K/1 ->g
356 # - <@> lineseq sK ->-
358 # 8 <0> pushmark s ->9
359 # - <1> ex-stringify sK/1 ->c
360 # - <0> ex-pushmark s ->9
361 # b <2> concat[t1] sK/2 ->c
362 # 9 <$> const(PV "foo ") s ->a
363 # - <1> ex-rv2sv sK/1 ->b
364 # a <$> gvsv(*_) s ->b
365 # d <0> unstack s ->e
368 checkOptree ( name => '-exec -e foreach (1..10) {print qq{foo $_}}',
369 prog => 'foreach (1..10) {print qq{foo $_}}',
372 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
374 # 2 <;> nextstate(main 2 -e:1) v
376 # 4 <$> const[IV 1] s
377 # 5 <$> const[IV 10] s
379 # 7 <{> enteriter(next->e last->h redo->8) lKS/8
381 # g <|> and(other->8) vK/1
382 # 8 <;> nextstate(main 1 -e:1) v
384 # a <$> const[PV "foo "] s
386 # c <2> concat[t4] sK/2
390 # h <2> leaveloop vK/2
391 # i <@> leave[1 ref] vKP/REFC
394 # 2 <;> nextstate(main 2 -e:1) v
396 # 4 <$> const(IV 1) s
397 # 5 <$> const(IV 10) s
399 # 7 <{> enteriter(next->e last->h redo->8) lKS/8
401 # g <|> and(other->8) vK/1
402 # 8 <;> nextstate(main 1 -e:1) v
404 # a <$> const(PV "foo ") s
406 # c <2> concat[t3] sK/2
410 # h <2> leaveloop vK/2
411 # i <@> leave[1 ref] vKP/REFC
414 checkOptree ( name => '-exec sub { print "foo $_" foreach (1..10) }',
415 code => sub { print "foo $_" foreach (1..10) },
418 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
419 # 1 <;> nextstate(main 445 optree.t:167) v
420 # 2 <;> nextstate(main 445 optree.t:167) v
422 # 4 <$> const[IV 1] s
423 # 5 <$> const[IV 10] s
425 # 7 <{> enteriter(next->d last->g redo->8) lKS/8
427 # f <|> and(other->8) K/1
429 # 9 <$> const[PV "foo "] s
431 # b <2> concat[t2] sK/2
435 # g <2> leaveloop K/2
436 # h <1> leavesub[1 ref] K/REFC,1
438 # 1 <;> nextstate(main 447 optree_samples.t:252) v
439 # 2 <;> nextstate(main 447 optree_samples.t:252) v
441 # 4 <$> const(IV 1) s
442 # 5 <$> const(IV 10) s
444 # 7 <{> enteriter(next->d last->g redo->8) lKS/8
446 # f <|> and(other->8) K/1
448 # 9 <$> const(PV "foo ") s
450 # b <2> concat[t1] sK/2
454 # g <2> leaveloop K/2
455 # h <1> leavesub[1 ref] K/REFC,1
458 pass("GREP: SAMPLES FROM PERLDOC -F GREP");
460 checkOptree ( name => '@foo = grep(!/^\#/, @bar)',
461 code => '@foo = grep(!/^\#/, @bar)',
463 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
464 # 1 <;> nextstate(main 496 (eval 20):1) v:{
468 # 5 <1> rv2av[t4] lKM/1
470 # 7 <|> grepwhile(other->8)[t5] lK
471 # 8 </> match(/"^#"/) s/RTIME
476 # c <1> rv2av[t2] lKRM*/1
477 # d <2> aassign[t6] KS/COMMON
478 # e <1> leavesub[1 ref] K/REFC,1
480 # 1 <;> nextstate(main 496 (eval 20):1) v:{
484 # 5 <1> rv2av[t2] lKM/1
486 # 7 <|> grepwhile(other->8)[t3] lK
487 # 8 </> match(/"^\\#"/) s/RTIME
492 # c <1> rv2av[t1] lKRM*/1
493 # d <2> aassign[t4] KS/COMMON
494 # e <1> leavesub[1 ref] K/REFC,1
498 pass("MAP: SAMPLES FROM PERLDOC -F MAP");
500 checkOptree ( name => '%h = map { getkey($_) => $_ } @a',
501 code => '%h = map { getkey($_) => $_ } @a',
503 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
504 # 1 <;> nextstate(main 501 (eval 22):1) v:{
508 # 5 <1> rv2av[t8] lKM/1
510 # 7 <|> mapwhile(other->8)[t9] lK
512 # 9 <;> nextstate(main 500 (eval 22):1) v:{
516 # d <#> gv[*getkey] s/EARLYCV
517 # e <1> entersub[t5] lKS/TARG,1
524 # k <1> rv2hv[t2] lKRM*/1
525 # l <2> aassign[t10] KS/COMMON
526 # m <1> leavesub[1 ref] K/REFC,1
528 # 1 <;> nextstate(main 501 (eval 22):1) v:{
532 # 5 <1> rv2av[t3] lKM/1
534 # 7 <|> mapwhile(other->8)[t4] lK
536 # 9 <;> nextstate(main 500 (eval 22):1) v:{
540 # d <$> gv(*getkey) s/EARLYCV
541 # e <1> entersub[t2] lKS/TARG,1
548 # k <1> rv2hv[t1] lKRM*/1
549 # l <2> aassign[t5] KS/COMMON
550 # m <1> leavesub[1 ref] K/REFC,1
553 checkOptree ( name => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
554 code => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
556 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
557 # 1 <;> nextstate(main 505 (eval 24):1) v
561 # 5 <1> rv2hv[t2] lKRM*/1
562 # 6 <2> aassign[t3] vKS
563 # 7 <;> nextstate(main 506 (eval 24):1) v:{
566 # a <1> rv2av[t6] sKRM/1
569 # d <{> enteriter(next->o last->r redo->e) lKS/8
571 # q <|> and(other->e) K/1
572 # e <;> nextstate(main 505 (eval 24):1) v:{
578 # k <#> gv[*getkey] s/EARLYCV
579 # l <1> entersub[t10] sKS/TARG,1
580 # m <2> helem sKRM*/2
581 # n <2> sassign vKS/2
584 # r <2> leaveloop K/2
585 # s <1> leavesub[1 ref] K/REFC,1
587 # 1 <;> nextstate(main 505 (eval 24):1) v
591 # 5 <1> rv2hv[t1] lKRM*/1
592 # 6 <2> aassign[t2] vKS
593 # 7 <;> nextstate(main 506 (eval 24):1) v:{
596 # a <1> rv2av[t3] sKRM/1
599 # d <{> enteriter(next->o last->r redo->e) lKS/8
601 # q <|> and(other->e) K/1
602 # e <;> nextstate(main 505 (eval 24):1) v:{
608 # k <$> gv(*getkey) s/EARLYCV
609 # l <1> entersub[t4] sKS/TARG,1
610 # m <2> helem sKRM*/2
611 # n <2> sassign vKS/2
614 # r <2> leaveloop K/2
615 # s <1> leavesub[1 ref] K/REFC,1
618 checkOptree ( name => 'map $_+42, 10..20',
619 code => 'map $_+42, 10..20',
621 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
622 # 1 <;> nextstate(main 497 (eval 20):1) v
627 # 6 <|> mapwhile(other->7)[t5] K
629 # 8 <$> const[IV 42] s
632 # a <1> leavesub[1 ref] K/REFC,1
634 # 1 <;> nextstate(main 511 (eval 26):1) v
639 # 6 <|> mapwhile(other->7)[t4] K
641 # 8 <$> const(IV 42) s
644 # a <1> leavesub[1 ref] K/REFC,1
649 checkOptree ( name => '-e use constant j => qq{junk}; print j',
650 prog => 'use constant j => qq{junk}; print j',
653 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
655 # 2 <;> nextstate(main 71 -e:1) v:{
657 # 4 <$> const[PV "junk"] s
659 # 6 <@> leave[1 ref] vKP/REFC
662 # 2 <;> nextstate(main 71 -e:1) v:{
664 # 4 <$> const(PV "junk") s
666 # 6 <@> leave[1 ref] vKP/REFC
673 #######################################################################
675 checkOptree ( name => '-exec sub a { print (shift) ? "foo" : "bar" }',
676 code => sub { print (shift) ? "foo" : "bar" },
678 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
679 insert threaded reference here
681 insert non-threaded reference here