5 @INC = ('../lib', '../ext/B/t');
7 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
8 print "1..0 # Skip -- Perl configured without B module\n";
11 if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
13 "1..0 # Skip: Data::Dumper was not built, needed by OptreeCheck\n";
18 print "1..0 # Skip -- TODO - provide golden result regexps for 5.8\n";
27 skip "no perlio in this build", 20 unless $Config::Config{useperlio};
29 pass("GENERAL OPTREE EXAMPLES");
31 pass("IF,THEN,ELSE, ?:");
33 checkOptree ( name => '-basic sub {if shift print then,else}',
35 code => sub { if (shift) { print "then" }
38 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
39 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
40 # - <@> lineseq KP ->9
41 # 1 <;> nextstate(main 426 optree.t:16) v ->2
43 # 5 <|> cond_expr(other->6) K/1 ->a
44 # 4 <1> shift sK/1 ->5
45 # 3 <1> rv2av[t2] sKRM/1 ->4
48 # - <0> ex-nextstate v ->6
50 # 6 <0> pushmark s ->7
51 # 7 <$> const[PV "then"] s ->8
54 # b <;> nextstate(main 424 optree.t:17) v ->c
56 # c <0> pushmark s ->d
57 # d <$> const[PV "else"] s ->e
59 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
60 # - <@> lineseq KP ->9
61 # 1 <;> nextstate(main 427 optree_samples.t:18) v ->2
63 # 5 <|> cond_expr(other->6) K/1 ->a
64 # 4 <1> shift sK/1 ->5
65 # 3 <1> rv2av[t1] sKRM/1 ->4
68 # - <0> ex-nextstate v ->6
70 # 6 <0> pushmark s ->7
71 # 7 <$> const(PV "then") s ->8
74 # b <;> nextstate(main 425 optree_samples.t:19) v ->c
76 # c <0> pushmark s ->d
77 # d <$> const(PV "else") s ->e
80 checkOptree ( name => '-basic (see above, with my $a = shift)',
82 code => sub { my $a = shift;
83 if ($a) { print "foo" }
86 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
87 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
88 # - <@> lineseq KP ->d
89 # 1 <;> nextstate(main 431 optree.t:68) v ->2
90 # 6 <2> sassign vKS/2 ->7
91 # 4 <1> shift sK/1 ->5
92 # 3 <1> rv2av[t3] sKRM/1 ->4
94 # 5 <0> padsv[$a:431,435] sRM*/LVINTRO ->6
95 # 7 <;> nextstate(main 435 optree.t:69) v ->8
97 # 9 <|> cond_expr(other->a) K/1 ->e
98 # 8 <0> padsv[$a:431,435] s ->9
100 # - <0> ex-nextstate v ->a
102 # a <0> pushmark s ->b
103 # b <$> const[PV "foo"] s ->c
106 # f <;> nextstate(main 433 optree.t:70) v ->g
108 # g <0> pushmark s ->h
109 # h <$> const[PV "bar"] s ->i
111 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
112 # - <@> lineseq KP ->d
113 # 1 <;> nextstate(main 428 optree_samples.t:48) v ->2
114 # 6 <2> sassign vKS/2 ->7
115 # 4 <1> shift sK/1 ->5
116 # 3 <1> rv2av[t2] sKRM/1 ->4
118 # 5 <0> padsv[$a:428,432] sRM*/LVINTRO ->6
119 # 7 <;> nextstate(main 432 optree_samples.t:49) v ->8
121 # 9 <|> cond_expr(other->a) K/1 ->e
122 # 8 <0> padsv[$a:428,432] s ->9
124 # - <0> ex-nextstate v ->a
126 # a <0> pushmark s ->b
127 # b <$> const(PV "foo") s ->c
130 # f <;> nextstate(main 430 optree_samples.t:50) v ->g
132 # g <0> pushmark s ->h
133 # h <$> const(PV "bar") s ->i
136 checkOptree ( name => '-exec sub {if shift print then,else}',
138 code => sub { if (shift) { print "then" }
139 else { print "else" }
141 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
142 # 1 <;> nextstate(main 426 optree.t:16) v
144 # 3 <1> rv2av[t2] sKRM/1
146 # 5 <|> cond_expr(other->6) K/1
148 # 7 <$> const[PV "then"] s
152 # b <;> nextstate(main 424 optree.t:17) v
154 # d <$> const[PV "else"] s
157 # 9 <1> leavesub[1 ref] K/REFC,1
159 # 1 <;> nextstate(main 436 optree_samples.t:123) v
161 # 3 <1> rv2av[t1] sKRM/1
163 # 5 <|> cond_expr(other->6) K/1
165 # 7 <$> const(PV "then") s
169 # b <;> nextstate(main 434 optree_samples.t:124) v
171 # d <$> const(PV "else") s
174 # 9 <1> leavesub[1 ref] K/REFC,1
177 checkOptree ( name => '-exec (see above, with my $a = shift)',
179 code => sub { my $a = shift;
180 if ($a) { print "foo" }
183 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
184 # 1 <;> nextstate(main 423 optree.t:16) v
186 # 3 <1> rv2av[t3] sKRM/1
188 # 5 <0> padsv[$a:423,427] sRM*/LVINTRO
189 # 6 <2> sassign vKS/2
190 # 7 <;> nextstate(main 427 optree.t:17) v
191 # 8 <0> padsv[$a:423,427] s
192 # 9 <|> cond_expr(other->a) K/1
194 # b <$> const[PV "foo"] s
198 # f <;> nextstate(main 425 optree.t:18) v
200 # h <$> const[PV "bar"] s
203 # d <1> leavesub[1 ref] K/REFC,1
205 # 1 <;> nextstate(main 437 optree_samples.t:112) v
207 # 3 <1> rv2av[t2] sKRM/1
209 # 5 <0> padsv[$a:437,441] sRM*/LVINTRO
210 # 6 <2> sassign vKS/2
211 # 7 <;> nextstate(main 441 optree_samples.t:113) v
212 # 8 <0> padsv[$a:437,441] s
213 # 9 <|> cond_expr(other->a) K/1
215 # b <$> const(PV "foo") s
219 # f <;> nextstate(main 439 optree_samples.t:114) v
221 # h <$> const(PV "bar") s
224 # d <1> leavesub[1 ref] K/REFC,1
227 checkOptree ( name => '-exec sub { print (shift) ? "foo" : "bar" }',
228 code => sub { print (shift) ? "foo" : "bar" },
230 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
231 # 1 <;> nextstate(main 428 optree.t:31) v
234 # 4 <1> rv2av[t2] sKRM/1
237 # 7 <|> cond_expr(other->8) K/1
238 # 8 <$> const[PV "foo"] s
240 # a <$> const[PV "bar"] s
241 # 9 <1> leavesub[1 ref] K/REFC,1
243 # 1 <;> nextstate(main 442 optree_samples.t:144) v
246 # 4 <1> rv2av[t1] sKRM/1
249 # 7 <|> cond_expr(other->8) K/1
250 # 8 <$> const(PV "foo") s
252 # a <$> const(PV "bar") s
253 # 9 <1> leavesub[1 ref] K/REFC,1
258 checkOptree ( name => '-exec sub { foreach (1..10) {print "foo $_"} }',
259 code => sub { foreach (1..10) {print "foo $_"} },
261 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
262 # 1 <;> nextstate(main 443 optree.t:158) v
264 # 3 <$> const[IV 1] s
265 # 4 <$> const[IV 10] s
267 # 6 <{> enteriter(next->d last->g redo->7) lKS
269 # f <|> and(other->7) K/1
270 # 7 <;> nextstate(main 442 optree.t:158) v
272 # 9 <$> const[PV "foo "] s
274 # b <2> concat[t4] sK/2
278 # g <2> leaveloop K/2
279 # h <1> leavesub[1 ref] K/REFC,1
281 # 1 <;> nextstate(main 444 optree_samples.t:182) v
283 # 3 <$> const(IV 1) s
284 # 4 <$> const(IV 10) s
286 # 6 <{> enteriter(next->d last->g redo->7) lKS
288 # f <|> and(other->7) K/1
289 # 7 <;> nextstate(main 443 optree_samples.t:182) v
291 # 9 <$> const(PV "foo ") s
293 # b <2> concat[t3] sK/2
297 # g <2> leaveloop K/2
298 # h <1> leavesub[1 ref] K/REFC,1
301 checkOptree ( name => '-basic sub { print "foo $_" foreach (1..10) }',
302 code => sub { print "foo $_" foreach (1..10) },
304 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
305 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
306 # - <@> lineseq KP ->h
307 # 1 <;> nextstate(main 445 optree.t:167) v ->2
308 # 2 <;> nextstate(main 445 optree.t:167) v ->3
309 # g <2> leaveloop K/2 ->h
310 # 7 <{> enteriter(next->d last->g redo->8) lKS ->e
311 # - <0> ex-pushmark s ->3
312 # - <1> ex-list lK ->6
313 # 3 <0> pushmark s ->4
314 # 4 <$> const[IV 1] s ->5
315 # 5 <$> const[IV 10] s ->6
318 # f <|> and(other->8) K/1 ->g
320 # - <@> lineseq sK ->-
322 # 8 <0> pushmark s ->9
323 # - <1> ex-stringify sK/1 ->c
324 # - <0> ex-pushmark s ->9
325 # b <2> concat[t2] sK/2 ->c
326 # 9 <$> const[PV "foo "] s ->a
327 # - <1> ex-rv2sv sK/1 ->b
328 # a <#> gvsv[*_] s ->b
329 # d <0> unstack s ->e
331 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
332 # - <@> lineseq KP ->h
333 # 1 <;> nextstate(main 446 optree_samples.t:192) v ->2
334 # 2 <;> nextstate(main 446 optree_samples.t:192) v ->3
335 # g <2> leaveloop K/2 ->h
336 # 7 <{> enteriter(next->d last->g redo->8) lKS ->e
337 # - <0> ex-pushmark s ->3
338 # - <1> ex-list lK ->6
339 # 3 <0> pushmark s ->4
340 # 4 <$> const(IV 1) s ->5
341 # 5 <$> const(IV 10) s ->6
344 # f <|> and(other->8) K/1 ->g
346 # - <@> lineseq sK ->-
348 # 8 <0> pushmark s ->9
349 # - <1> ex-stringify sK/1 ->c
350 # - <0> ex-pushmark s ->9
351 # b <2> concat[t1] sK/2 ->c
352 # 9 <$> const(PV "foo ") s ->a
353 # - <1> ex-rv2sv sK/1 ->b
354 # a <$> gvsv(*_) s ->b
355 # d <0> unstack s ->e
358 checkOptree ( name => '-exec -e foreach (1..10) {print qq{foo $_}}',
359 prog => 'foreach (1..10) {print qq{foo $_}}',
361 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
363 # 2 <;> nextstate(main 2 -e:1) v
365 # 4 <$> const[IV 1] s
366 # 5 <$> const[IV 10] s
368 # 7 <{> enteriter(next->e last->h redo->8) lKS
370 # g <|> and(other->8) vK/1
371 # 8 <;> nextstate(main 1 -e:1) v
373 # a <$> const[PV "foo "] s
375 # c <2> concat[t4] sK/2
379 # h <2> leaveloop vK/2
380 # i <@> leave[1 ref] vKP/REFC
383 # 2 <;> nextstate(main 2 -e:1) v
385 # 4 <$> const(IV 1) s
386 # 5 <$> const(IV 10) s
388 # 7 <{> enteriter(next->e last->h redo->8) lKS
390 # g <|> and(other->8) vK/1
391 # 8 <;> nextstate(main 1 -e:1) v
393 # a <$> const(PV "foo ") s
395 # c <2> concat[t3] sK/2
399 # h <2> leaveloop vK/2
400 # i <@> leave[1 ref] vKP/REFC
403 checkOptree ( name => '-exec sub { print "foo $_" foreach (1..10) }',
404 code => sub { print "foo $_" foreach (1..10) },
406 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
407 # 1 <;> nextstate(main 445 optree.t:167) v
408 # 2 <;> nextstate(main 445 optree.t:167) v
410 # 4 <$> const[IV 1] s
411 # 5 <$> const[IV 10] s
413 # 7 <{> enteriter(next->d last->g redo->8) lKS
415 # f <|> and(other->8) K/1
417 # 9 <$> const[PV "foo "] s
419 # b <2> concat[t2] sK/2
423 # g <2> leaveloop K/2
424 # h <1> leavesub[1 ref] K/REFC,1
426 # 1 <;> nextstate(main 447 optree_samples.t:252) v
427 # 2 <;> nextstate(main 447 optree_samples.t:252) v
429 # 4 <$> const(IV 1) s
430 # 5 <$> const(IV 10) s
432 # 7 <{> enteriter(next->d last->g redo->8) lKS
434 # f <|> and(other->8) K/1
436 # 9 <$> const(PV "foo ") s
438 # b <2> concat[t1] sK/2
442 # g <2> leaveloop K/2
443 # h <1> leavesub[1 ref] K/REFC,1
446 pass("GREP: SAMPLES FROM PERLDOC -F GREP");
448 checkOptree ( name => '@foo = grep(!/^\#/, @bar)',
449 code => '@foo = grep(!/^\#/, @bar)',
451 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
452 # 1 <;> nextstate(main 496 (eval 20):1) v
456 # 5 <1> rv2av[t4] lKM/1
458 # 7 <|> grepwhile(other->8)[t5] lK
459 # 8 </> match(/"^#"/) s/RTIME
464 # c <1> rv2av[t2] lKRM*/1
465 # d <2> aassign[t6] KS/COMMON
466 # e <1> leavesub[1 ref] K/REFC,1
468 # 1 <;> nextstate(main 496 (eval 20):1) v
472 # 5 <1> rv2av[t2] lKM/1
474 # 7 <|> grepwhile(other->8)[t3] lK
475 # 8 </> match(/"^\\#"/) s/RTIME
480 # c <1> rv2av[t1] lKRM*/1
481 # d <2> aassign[t4] KS/COMMON
482 # e <1> leavesub[1 ref] K/REFC,1
486 pass("MAP: SAMPLES FROM PERLDOC -F MAP");
488 checkOptree ( name => '%h = map { getkey($_) => $_ } @a',
489 code => '%h = map { getkey($_) => $_ } @a',
491 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
492 # 1 <;> nextstate(main 501 (eval 22):1) v
496 # 5 <1> rv2av[t8] lKM/1
498 # 7 <|> mapwhile(other->8)[t9] lK
500 # 9 <;> nextstate(main 500 (eval 22):1) v
504 # d <#> gv[*getkey] s/EARLYCV
505 # e <1> entersub[t5] lKS/TARG,1
512 # k <1> rv2hv[t2] lKRM*/1
513 # l <2> aassign[t10] KS/COMMON
514 # m <1> leavesub[1 ref] K/REFC,1
516 # 1 <;> nextstate(main 501 (eval 22):1) v
520 # 5 <1> rv2av[t3] lKM/1
522 # 7 <|> mapwhile(other->8)[t4] lK
524 # 9 <;> nextstate(main 500 (eval 22):1) v
528 # d <$> gv(*getkey) s/EARLYCV
529 # e <1> entersub[t2] lKS/TARG,1
536 # k <1> rv2hv[t1] lKRM*/1
537 # l <2> aassign[t5] KS/COMMON
538 # m <1> leavesub[1 ref] K/REFC,1
541 checkOptree ( name => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
542 code => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
544 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
545 # 1 <;> nextstate(main 505 (eval 24):1) v
549 # 5 <1> rv2hv[t2] lKRM*/1
550 # 6 <2> aassign[t3] vKS
551 # 7 <;> nextstate(main 506 (eval 24):1) v
554 # a <1> rv2av[t6] sKRM/1
557 # d <{> enteriter(next->o last->r redo->e) lKS
559 # q <|> and(other->e) K/1
560 # e <;> nextstate(main 505 (eval 24):1) v
566 # k <#> gv[*getkey] s/EARLYCV
567 # l <1> entersub[t10] sKS/TARG,1
568 # m <2> helem sKRM*/2
569 # n <2> sassign vKS/2
572 # r <2> leaveloop K/2
573 # s <1> leavesub[1 ref] K/REFC,1
575 # 1 <;> nextstate(main 505 (eval 24):1) v
579 # 5 <1> rv2hv[t1] lKRM*/1
580 # 6 <2> aassign[t2] vKS
581 # 7 <;> nextstate(main 506 (eval 24):1) v
584 # a <1> rv2av[t3] sKRM/1
587 # d <{> enteriter(next->o last->r redo->e) lKS
589 # q <|> and(other->e) K/1
590 # e <;> nextstate(main 505 (eval 24):1) v
596 # k <$> gv(*getkey) s/EARLYCV
597 # l <1> entersub[t4] sKS/TARG,1
598 # m <2> helem sKRM*/2
599 # n <2> sassign vKS/2
602 # r <2> leaveloop K/2
603 # s <1> leavesub[1 ref] K/REFC,1
606 checkOptree ( name => 'map $_+42, 10..20',
607 code => 'map $_+42, 10..20',
609 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
610 # 1 <;> nextstate(main 497 (eval 20):1) v
615 # 6 <|> mapwhile(other->7)[t7] K
617 # 8 <$> const[IV 42] s
620 # a <1> leavesub[1 ref] K/REFC,1
622 # 1 <;> nextstate(main 511 (eval 26):1) v
627 # 6 <|> mapwhile(other->7)[t4] K
629 # 8 <$> const(IV 42) s
632 # a <1> leavesub[1 ref] K/REFC,1
637 checkOptree ( name => '-e use constant j => qq{junk}; print j',
638 prog => 'use constant j => qq{junk}; print j',
640 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
642 # 2 <;> nextstate(main 71 -e:1) v
644 # 4 <$> const[PV "junk"] s
646 # 6 <@> leave[1 ref] vKP/REFC
649 # 2 <;> nextstate(main 71 -e:1) v
651 # 4 <$> const(PV "junk") s
653 # 6 <@> leave[1 ref] vKP/REFC
660 #######################################################################
662 checkOptree ( name => '-exec sub a { print (shift) ? "foo" : "bar" }',
663 code => sub { print (shift) ? "foo" : "bar" },
665 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
666 insert threaded reference here
668 insert non-threaded reference here