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 strip_open_hints => 1,
34 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
35 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
36 # - <@> lineseq KP ->9
37 # 1 <;> nextstate(main 426 optree.t:16) v:>,<,% ->2
39 # 5 <|> cond_expr(other->6) K/1 ->a
40 # 4 <1> shift sK/1 ->5
41 # 3 <1> rv2av[t2] sKRM/1 ->4
44 # - <0> ex-nextstate v ->6
46 # 6 <0> pushmark s ->7
47 # 7 <$> const[PV "then"] s ->8
50 # b <;> nextstate(main 424 optree.t:17) v:>,<,% ->c
52 # c <0> pushmark s ->d
53 # d <$> const[PV "else"] s ->e
55 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
56 # - <@> lineseq KP ->9
57 # 1 <;> nextstate(main 427 optree_samples.t:18) v:>,<,% ->2
59 # 5 <|> cond_expr(other->6) K/1 ->a
60 # 4 <1> shift sK/1 ->5
61 # 3 <1> rv2av[t1] sKRM/1 ->4
64 # - <0> ex-nextstate v ->6
66 # 6 <0> pushmark s ->7
67 # 7 <$> const(PV "then") s ->8
70 # b <;> nextstate(main 425 optree_samples.t:19) v:>,<,% ->c
72 # c <0> pushmark s ->d
73 # d <$> const(PV "else") s ->e
76 checkOptree ( name => '-basic (see above, with my $a = shift)',
78 code => sub { my $a = shift;
79 if ($a) { print "foo" }
82 strip_open_hints => 1,
83 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
84 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
85 # - <@> lineseq KP ->d
86 # 1 <;> nextstate(main 431 optree.t:68) v:>,<,% ->2
87 # 6 <2> sassign vKS/2 ->7
88 # 4 <1> shift sK/1 ->5
89 # 3 <1> rv2av[t3] sKRM/1 ->4
91 # 5 <0> padsv[$a:431,435] sRM*/LVINTRO ->6
92 # 7 <;> nextstate(main 435 optree.t:69) v:>,<,% ->8
94 # 9 <|> cond_expr(other->a) K/1 ->e
95 # 8 <0> padsv[$a:431,435] s ->9
97 # - <0> ex-nextstate v ->a
99 # a <0> pushmark s ->b
100 # b <$> const[PV "foo"] s ->c
103 # f <;> nextstate(main 433 optree.t:70) v:>,<,% ->g
105 # g <0> pushmark s ->h
106 # h <$> const[PV "bar"] s ->i
108 # d <1> leavesub[1 ref] K/REFC,1 ->(end)
109 # - <@> lineseq KP ->d
110 # 1 <;> nextstate(main 428 optree_samples.t:48) v:>,<,% ->2
111 # 6 <2> sassign vKS/2 ->7
112 # 4 <1> shift sK/1 ->5
113 # 3 <1> rv2av[t2] sKRM/1 ->4
115 # 5 <0> padsv[$a:428,432] sRM*/LVINTRO ->6
116 # 7 <;> nextstate(main 432 optree_samples.t:49) v:>,<,% ->8
118 # 9 <|> cond_expr(other->a) K/1 ->e
119 # 8 <0> padsv[$a:428,432] s ->9
121 # - <0> ex-nextstate v ->a
123 # a <0> pushmark s ->b
124 # b <$> const(PV "foo") s ->c
127 # f <;> nextstate(main 430 optree_samples.t:50) v:>,<,% ->g
129 # g <0> pushmark s ->h
130 # h <$> const(PV "bar") s ->i
133 checkOptree ( name => '-exec sub {if shift print then,else}',
135 code => sub { if (shift) { print "then" }
136 else { print "else" }
138 strip_open_hints => 1,
139 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
140 # 1 <;> nextstate(main 426 optree.t:16) v:>,<,%
142 # 3 <1> rv2av[t2] sKRM/1
144 # 5 <|> cond_expr(other->6) K/1
146 # 7 <$> const[PV "then"] s
150 # b <;> nextstate(main 424 optree.t:17) v:>,<,%
152 # d <$> const[PV "else"] s
155 # 9 <1> leavesub[1 ref] K/REFC,1
157 # 1 <;> nextstate(main 436 optree_samples.t:123) v:>,<,%
159 # 3 <1> rv2av[t1] sKRM/1
161 # 5 <|> cond_expr(other->6) K/1
163 # 7 <$> const(PV "then") s
167 # b <;> nextstate(main 434 optree_samples.t:124) v:>,<,%
169 # d <$> const(PV "else") s
172 # 9 <1> leavesub[1 ref] K/REFC,1
175 checkOptree ( name => '-exec (see above, with my $a = shift)',
177 code => sub { my $a = shift;
178 if ($a) { print "foo" }
181 strip_open_hints => 1,
182 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
183 # 1 <;> nextstate(main 423 optree.t:16) v:>,<,%
185 # 3 <1> rv2av[t3] sKRM/1
187 # 5 <0> padsv[$a:423,427] sRM*/LVINTRO
188 # 6 <2> sassign vKS/2
189 # 7 <;> nextstate(main 427 optree.t:17) v:>,<,%
190 # 8 <0> padsv[$a:423,427] s
191 # 9 <|> cond_expr(other->a) K/1
193 # b <$> const[PV "foo"] s
197 # f <;> nextstate(main 425 optree.t:18) v:>,<,%
199 # h <$> const[PV "bar"] s
202 # d <1> leavesub[1 ref] K/REFC,1
204 # 1 <;> nextstate(main 437 optree_samples.t:112) v:>,<,%
206 # 3 <1> rv2av[t2] sKRM/1
208 # 5 <0> padsv[$a:437,441] sRM*/LVINTRO
209 # 6 <2> sassign vKS/2
210 # 7 <;> nextstate(main 441 optree_samples.t:113) v:>,<,%
211 # 8 <0> padsv[$a:437,441] s
212 # 9 <|> cond_expr(other->a) K/1
214 # b <$> const(PV "foo") s
218 # f <;> nextstate(main 439 optree_samples.t:114) v:>,<,%
220 # h <$> const(PV "bar") s
223 # d <1> leavesub[1 ref] K/REFC,1
226 checkOptree ( name => '-exec sub { print (shift) ? "foo" : "bar" }',
227 code => sub { print (shift) ? "foo" : "bar" },
229 strip_open_hints => 1,
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 strip_open_hints => 1,
262 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
263 # 1 <;> nextstate(main 443 optree.t:158) v:>,<,%
265 # 3 <$> const[IV 1] s
266 # 4 <$> const[IV 10] s
268 # 6 <{> enteriter(next->d last->g redo->7) lKS/8
270 # f <|> and(other->7) K/1
271 # 7 <;> nextstate(main 442 optree.t:158) v:>,<,%
273 # 9 <$> const[PV "foo "] s
275 # b <2> concat[t4] sK/2
279 # g <2> leaveloop K/2
280 # h <1> leavesub[1 ref] K/REFC,1
282 # 1 <;> nextstate(main 444 optree_samples.t:182) v:>,<,%
284 # 3 <$> const(IV 1) s
285 # 4 <$> const(IV 10) s
287 # 6 <{> enteriter(next->d last->g redo->7) lKS/8
289 # f <|> and(other->7) K/1
290 # 7 <;> nextstate(main 443 optree_samples.t:182) v:>,<,%
292 # 9 <$> const(PV "foo ") s
294 # b <2> concat[t3] sK/2
298 # g <2> leaveloop K/2
299 # h <1> leavesub[1 ref] K/REFC,1
302 checkOptree ( name => '-basic sub { print "foo $_" foreach (1..10) }',
303 code => sub { print "foo $_" foreach (1..10) },
305 strip_open_hints => 1,
306 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
307 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
308 # - <@> lineseq KP ->h
309 # 1 <;> nextstate(main 445 optree.t:167) v:>,<,% ->2
310 # 2 <;> nextstate(main 445 optree.t:167) v:>,<,% ->3
311 # g <2> leaveloop K/2 ->h
312 # 7 <{> enteriter(next->d last->g redo->8) lKS/8 ->e
313 # - <0> ex-pushmark s ->3
314 # - <1> ex-list lK ->6
315 # 3 <0> pushmark s ->4
316 # 4 <$> const[IV 1] s ->5
317 # 5 <$> const[IV 10] s ->6
320 # f <|> and(other->8) K/1 ->g
322 # - <@> lineseq sK ->-
324 # 8 <0> pushmark s ->9
325 # - <1> ex-stringify sK/1 ->c
326 # - <0> ex-pushmark s ->9
327 # b <2> concat[t2] sK/2 ->c
328 # 9 <$> const[PV "foo "] s ->a
329 # - <1> ex-rv2sv sK/1 ->b
330 # a <#> gvsv[*_] s ->b
331 # d <0> unstack s ->e
333 # h <1> leavesub[1 ref] K/REFC,1 ->(end)
334 # - <@> lineseq KP ->h
335 # 1 <;> nextstate(main 446 optree_samples.t:192) v:>,<,% ->2
336 # 2 <;> nextstate(main 446 optree_samples.t:192) v:>,<,% ->3
337 # g <2> leaveloop K/2 ->h
338 # 7 <{> enteriter(next->d last->g redo->8) lKS/8 ->e
339 # - <0> ex-pushmark s ->3
340 # - <1> ex-list lK ->6
341 # 3 <0> pushmark s ->4
342 # 4 <$> const(IV 1) s ->5
343 # 5 <$> const(IV 10) s ->6
346 # f <|> and(other->8) K/1 ->g
348 # - <@> lineseq sK ->-
350 # 8 <0> pushmark s ->9
351 # - <1> ex-stringify sK/1 ->c
352 # - <0> ex-pushmark s ->9
353 # b <2> concat[t1] sK/2 ->c
354 # 9 <$> const(PV "foo ") s ->a
355 # - <1> ex-rv2sv sK/1 ->b
356 # a <$> gvsv(*_) s ->b
357 # d <0> unstack s ->e
360 checkOptree ( name => '-exec -e foreach (1..10) {print qq{foo $_}}',
361 prog => 'foreach (1..10) {print qq{foo $_}}',
363 strip_open_hints => 1,
364 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
366 # 2 <;> nextstate(main 2 -e:1) v:>,<,%
368 # 4 <$> const[IV 1] s
369 # 5 <$> const[IV 10] s
371 # 7 <{> enteriter(next->e last->h redo->8) lKS/8
373 # g <|> and(other->8) vK/1
374 # 8 <;> nextstate(main 1 -e:1) v:>,<,%
376 # a <$> const[PV "foo "] s
378 # c <2> concat[t4] sK/2
382 # h <2> leaveloop vK/2
383 # i <@> leave[1 ref] vKP/REFC
386 # 2 <;> nextstate(main 2 -e:1) v:>,<,%
388 # 4 <$> const(IV 1) s
389 # 5 <$> const(IV 10) s
391 # 7 <{> enteriter(next->e last->h redo->8) lKS/8
393 # g <|> and(other->8) vK/1
394 # 8 <;> nextstate(main 1 -e:1) v:>,<,%
396 # a <$> const(PV "foo ") s
398 # c <2> concat[t3] sK/2
402 # h <2> leaveloop vK/2
403 # i <@> leave[1 ref] vKP/REFC
406 checkOptree ( name => '-exec sub { print "foo $_" foreach (1..10) }',
407 code => sub { print "foo $_" foreach (1..10) },
409 strip_open_hints => 1,
410 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
411 # 1 <;> nextstate(main 445 optree.t:167) v:>,<,%
412 # 2 <;> nextstate(main 445 optree.t:167) v:>,<,%
414 # 4 <$> const[IV 1] s
415 # 5 <$> const[IV 10] s
417 # 7 <{> enteriter(next->d last->g redo->8) lKS/8
419 # f <|> and(other->8) K/1
421 # 9 <$> const[PV "foo "] s
423 # b <2> concat[t2] sK/2
427 # g <2> leaveloop K/2
428 # h <1> leavesub[1 ref] K/REFC,1
430 # 1 <;> nextstate(main 447 optree_samples.t:252) v:>,<,%
431 # 2 <;> nextstate(main 447 optree_samples.t:252) v:>,<,%
433 # 4 <$> const(IV 1) s
434 # 5 <$> const(IV 10) s
436 # 7 <{> enteriter(next->d last->g redo->8) lKS/8
438 # f <|> and(other->8) K/1
440 # 9 <$> const(PV "foo ") s
442 # b <2> concat[t1] sK/2
446 # g <2> leaveloop K/2
447 # h <1> leavesub[1 ref] K/REFC,1
450 pass("GREP: SAMPLES FROM PERLDOC -F GREP");
452 checkOptree ( name => '@foo = grep(!/^\#/, @bar)',
453 code => '@foo = grep(!/^\#/, @bar)',
455 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
456 # 1 <;> nextstate(main 496 (eval 20):1) v:{
460 # 5 <1> rv2av[t4] lKM/1
462 # 7 <|> grepwhile(other->8)[t5] lK
463 # 8 </> match(/"^#"/) s/RTIME
468 # c <1> rv2av[t2] lKRM*/1
469 # d <2> aassign[t6] KS/COMMON
470 # e <1> leavesub[1 ref] K/REFC,1
472 # 1 <;> nextstate(main 496 (eval 20):1) v:{
476 # 5 <1> rv2av[t2] lKM/1
478 # 7 <|> grepwhile(other->8)[t3] lK
479 # 8 </> match(/"^\\#"/) s/RTIME
484 # c <1> rv2av[t1] lKRM*/1
485 # d <2> aassign[t4] KS/COMMON
486 # e <1> leavesub[1 ref] K/REFC,1
490 pass("MAP: SAMPLES FROM PERLDOC -F MAP");
492 checkOptree ( name => '%h = map { getkey($_) => $_ } @a',
493 code => '%h = map { getkey($_) => $_ } @a',
495 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
496 # 1 <;> nextstate(main 501 (eval 22):1) v:{
500 # 5 <1> rv2av[t8] lKM/1
502 # 7 <|> mapwhile(other->8)[t9] lK
504 # 9 <;> nextstate(main 500 (eval 22):1) v:{
508 # d <#> gv[*getkey] s/EARLYCV
509 # e <1> entersub[t5] lKS/TARG,1
516 # k <1> rv2hv[t2] lKRM*/1
517 # l <2> aassign[t10] KS/COMMON
518 # m <1> leavesub[1 ref] K/REFC,1
520 # 1 <;> nextstate(main 501 (eval 22):1) v:{
524 # 5 <1> rv2av[t3] lKM/1
526 # 7 <|> mapwhile(other->8)[t4] lK
528 # 9 <;> nextstate(main 500 (eval 22):1) v:{
532 # d <$> gv(*getkey) s/EARLYCV
533 # e <1> entersub[t2] lKS/TARG,1
540 # k <1> rv2hv[t1] lKRM*/1
541 # l <2> aassign[t5] KS/COMMON
542 # m <1> leavesub[1 ref] K/REFC,1
545 checkOptree ( name => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
546 code => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
548 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
549 # 1 <;> nextstate(main 505 (eval 24):1) v
553 # 5 <1> rv2hv[t2] lKRM*/1
554 # 6 <2> aassign[t3] vKS
555 # 7 <;> nextstate(main 506 (eval 24):1) v:{
558 # a <1> rv2av[t6] sKRM/1
561 # d <{> enteriter(next->o last->r redo->e) lKS/8
563 # q <|> and(other->e) K/1
564 # e <;> nextstate(main 505 (eval 24):1) v:{
570 # k <#> gv[*getkey] s/EARLYCV
571 # l <1> entersub[t10] sKS/TARG,1
572 # m <2> helem sKRM*/2
573 # n <2> sassign vKS/2
576 # r <2> leaveloop K/2
577 # s <1> leavesub[1 ref] K/REFC,1
579 # 1 <;> nextstate(main 505 (eval 24):1) v
583 # 5 <1> rv2hv[t1] lKRM*/1
584 # 6 <2> aassign[t2] vKS
585 # 7 <;> nextstate(main 506 (eval 24):1) v:{
588 # a <1> rv2av[t3] sKRM/1
591 # d <{> enteriter(next->o last->r redo->e) lKS/8
593 # q <|> and(other->e) K/1
594 # e <;> nextstate(main 505 (eval 24):1) v:{
600 # k <$> gv(*getkey) s/EARLYCV
601 # l <1> entersub[t4] sKS/TARG,1
602 # m <2> helem sKRM*/2
603 # n <2> sassign vKS/2
606 # r <2> leaveloop K/2
607 # s <1> leavesub[1 ref] K/REFC,1
610 checkOptree ( name => 'map $_+42, 10..20',
611 code => 'map $_+42, 10..20',
613 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
614 # 1 <;> nextstate(main 497 (eval 20):1) v
619 # 6 <|> mapwhile(other->7)[t5] K
621 # 8 <$> const[IV 42] s
624 # a <1> leavesub[1 ref] K/REFC,1
626 # 1 <;> nextstate(main 511 (eval 26):1) v
631 # 6 <|> mapwhile(other->7)[t4] K
633 # 8 <$> const(IV 42) s
636 # a <1> leavesub[1 ref] K/REFC,1
641 checkOptree ( name => '-e use constant j => qq{junk}; print j',
642 prog => 'use constant j => qq{junk}; print j',
644 strip_open_hints => 1,
645 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
647 # 2 <;> nextstate(main 71 -e:1) v:>,<,%,{
649 # 4 <$> const[PV "junk"] s
651 # 6 <@> leave[1 ref] vKP/REFC
654 # 2 <;> nextstate(main 71 -e:1) v:>,<,%,{
656 # 4 <$> const(PV "junk") s
658 # 6 <@> leave[1 ref] vKP/REFC
665 #######################################################################
667 checkOptree ( name => '-exec sub a { print (shift) ? "foo" : "bar" }',
668 code => sub { print (shift) ? "foo" : "bar" },
670 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
671 insert threaded reference here
673 insert non-threaded reference here