This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add new dUNDERBAR and UNDERBAR macros, to help XS writers to
[perl5.git] / ext / B / t / optree_samples.t
CommitLineData
724aa791
JC
1#!perl
2
3BEGIN {
4 chdir 't';
5 @INC = ('../lib', '../ext/B/t');
6 require './test.pl';
7}
8use OptreeCheck;
2ce64696 9use Config;
724aa791 10plan tests => 13;
2ce64696
JC
11SKIP: {
12 skip "no perlio in this build", 13 unless $Config::Config{useperlio};
724aa791
JC
13
14pass("GENERAL OPTREE EXAMPLES");
15
16pass("IF,THEN,ELSE, ?:");
17
18checkOptree ( name => '-basic sub {if shift print then,else}',
19 bcopts => '-basic',
20 code => sub { if (shift) { print "then" }
21 else { print "else" }
22 },
23 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
24# B::Concise::compile(CODE(0x81a77b4))
25# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
26# - <@> lineseq KP ->9
27# 1 <;> nextstate(main 426 optree.t:16) v ->2
28# - <1> null K/1 ->-
29# 5 <|> cond_expr(other->6) K/1 ->a
30# 4 <1> shift sK/1 ->5
31# 3 <1> rv2av[t2] sKRM/1 ->4
32# 2 <#> gv[*_] s ->3
33# - <@> scope K ->-
34# - <0> ex-nextstate v ->6
35# 8 <@> print sK ->9
36# 6 <0> pushmark s ->7
37# 7 <$> const[PV "then"] s ->8
38# f <@> leave KP ->9
39# a <0> enter ->b
40# b <;> nextstate(main 424 optree.t:17) v ->c
41# e <@> print sK ->f
42# c <0> pushmark s ->d
43# d <$> const[PV "else"] s ->e
44EOT_EOT
45# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
46# - <@> lineseq KP ->9
47# 1 <;> nextstate(main 427 optree_samples.t:18) v ->2
48# - <1> null K/1 ->-
49# 5 <|> cond_expr(other->6) K/1 ->a
50# 4 <1> shift sK/1 ->5
51# 3 <1> rv2av[t1] sKRM/1 ->4
52# 2 <$> gv(*_) s ->3
53# - <@> scope K ->-
54# - <0> ex-nextstate v ->6
55# 8 <@> print sK ->9
56# 6 <0> pushmark s ->7
57# 7 <$> const(PV "then") s ->8
58# f <@> leave KP ->9
59# a <0> enter ->b
60# b <;> nextstate(main 425 optree_samples.t:19) v ->c
61# e <@> print sK ->f
62# c <0> pushmark s ->d
63# d <$> const(PV "else") s ->e
64EONT_EONT
65
66checkOptree ( name => '-basic (see above, with my $a = shift)',
67 bcopts => '-basic',
68 code => sub { my $a = shift;
69 if ($a) { print "foo" }
70 else { print "bar" }
71 },
72 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
73# d <1> leavesub[1 ref] K/REFC,1 ->(end)
74# - <@> lineseq KP ->d
75# 1 <;> nextstate(main 431 optree.t:68) v ->2
76# 6 <2> sassign vKS/2 ->7
77# 4 <1> shift sK/1 ->5
78# 3 <1> rv2av[t3] sKRM/1 ->4
79# 2 <#> gv[*_] s ->3
80# 5 <0> padsv[$a:431,435] sRM*/LVINTRO ->6
81# 7 <;> nextstate(main 435 optree.t:69) v ->8
82# - <1> null K/1 ->-
83# 9 <|> cond_expr(other->a) K/1 ->e
84# 8 <0> padsv[$a:431,435] s ->9
85# - <@> scope K ->-
86# - <0> ex-nextstate v ->a
87# c <@> print sK ->d
88# a <0> pushmark s ->b
89# b <$> const[PV "foo"] s ->c
90# j <@> leave KP ->d
91# e <0> enter ->f
92# f <;> nextstate(main 433 optree.t:70) v ->g
93# i <@> print sK ->j
94# g <0> pushmark s ->h
95# h <$> const[PV "bar"] s ->i
96EOT_EOT
97# 1 <;> nextstate(main 45 optree.t:23) v
98# 2 <0> padsv[$a:45,46] M/LVINTRO
99# 3 <1> leavesub[1 ref] K/REFC,1
100# d <1> leavesub[1 ref] K/REFC,1 ->(end)
101# - <@> lineseq KP ->d
102# 1 <;> nextstate(main 428 optree_samples.t:48) v ->2
103# 6 <2> sassign vKS/2 ->7
104# 4 <1> shift sK/1 ->5
105# 3 <1> rv2av[t2] sKRM/1 ->4
106# 2 <$> gv(*_) s ->3
107# 5 <0> padsv[$a:428,432] sRM*/LVINTRO ->6
108# 7 <;> nextstate(main 432 optree_samples.t:49) v ->8
109# - <1> null K/1 ->-
110# 9 <|> cond_expr(other->a) K/1 ->e
111# 8 <0> padsv[$a:428,432] s ->9
112# - <@> scope K ->-
113# - <0> ex-nextstate v ->a
114# c <@> print sK ->d
115# a <0> pushmark s ->b
116# b <$> const(PV "foo") s ->c
117# j <@> leave KP ->d
118# e <0> enter ->f
119# f <;> nextstate(main 430 optree_samples.t:50) v ->g
120# i <@> print sK ->j
121# g <0> pushmark s ->h
122# h <$> const(PV "bar") s ->i
123EONT_EONT
124
125checkOptree ( name => '-exec sub {if shift print then,else}',
126 bcopts => '-exec',
127 code => sub { if (shift) { print "then" }
128 else { print "else" }
129 },
130 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
131# B::Concise::compile(CODE(0x81a77b4))
132# 1 <;> nextstate(main 426 optree.t:16) v
133# 2 <#> gv[*_] s
134# 3 <1> rv2av[t2] sKRM/1
135# 4 <1> shift sK/1
136# 5 <|> cond_expr(other->6) K/1
137# 6 <0> pushmark s
138# 7 <$> const[PV "then"] s
139# 8 <@> print sK
140# goto 9
141# a <0> enter
142# b <;> nextstate(main 424 optree.t:17) v
143# c <0> pushmark s
144# d <$> const[PV "else"] s
145# e <@> print sK
146# f <@> leave KP
147# 9 <1> leavesub[1 ref] K/REFC,1
148EOT_EOT
149# 1 <;> nextstate(main 436 optree_samples.t:123) v
150# 2 <$> gv(*_) s
151# 3 <1> rv2av[t1] sKRM/1
152# 4 <1> shift sK/1
153# 5 <|> cond_expr(other->6) K/1
154# 6 <0> pushmark s
155# 7 <$> const(PV "then") s
156# 8 <@> print sK
157# goto 9
158# a <0> enter
159# b <;> nextstate(main 434 optree_samples.t:124) v
160# c <0> pushmark s
161# d <$> const(PV "else") s
162# e <@> print sK
163# f <@> leave KP
164# 9 <1> leavesub[1 ref] K/REFC,1
165EONT_EONT
166
167checkOptree ( name => '-exec (see above, with my $a = shift)',
168 bcopts => '-exec',
169 code => sub { my $a = shift;
170 if ($a) { print "foo" }
171 else { print "bar" }
172 },
173 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
174# 1 <;> nextstate(main 423 optree.t:16) v
175# 2 <#> gv[*_] s
176# 3 <1> rv2av[t3] sKRM/1
177# 4 <1> shift sK/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
183# a <0> pushmark s
184# b <$> const[PV "foo"] s
185# c <@> print sK
186# goto d
187# e <0> enter
188# f <;> nextstate(main 425 optree.t:18) v
189# g <0> pushmark s
190# h <$> const[PV "bar"] s
191# i <@> print sK
192# j <@> leave KP
193# d <1> leavesub[1 ref] K/REFC,1
194EOT_EOT
195# 1 <;> nextstate(main 437 optree_samples.t:112) v
196# 2 <$> gv(*_) s
197# 3 <1> rv2av[t2] sKRM/1
198# 4 <1> shift sK/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
204# a <0> pushmark s
205# b <$> const(PV "foo") s
206# c <@> print sK
207# goto d
208# e <0> enter
209# f <;> nextstate(main 439 optree_samples.t:114) v
210# g <0> pushmark s
211# h <$> const(PV "bar") s
212# i <@> print sK
213# j <@> leave KP
214# d <1> leavesub[1 ref] K/REFC,1
215EONT_EONT
216
217checkOptree ( name => '-exec sub { print (shift) ? "foo" : "bar" }',
218 code => sub { print (shift) ? "foo" : "bar" },
219 bcopts => '-exec',
220 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
221# 1 <;> nextstate(main 428 optree.t:31) v
222# 2 <0> pushmark s
223# 3 <#> gv[*_] s
224# 4 <1> rv2av[t2] sKRM/1
225# 5 <1> shift sK/1
226# 6 <@> print sK
227# 7 <|> cond_expr(other->8) K/1
228# 8 <$> const[PV "foo"] s
229# goto 9
230# a <$> const[PV "bar"] s
231# 9 <1> leavesub[1 ref] K/REFC,1
232EOT_EOT
233# 1 <;> nextstate(main 442 optree_samples.t:144) v
234# 2 <0> pushmark s
235# 3 <$> gv(*_) s
236# 4 <1> rv2av[t1] sKRM/1
237# 5 <1> shift sK/1
238# 6 <@> print sK
239# 7 <|> cond_expr(other->8) K/1
240# 8 <$> const(PV "foo") s
241# goto 9
242# a <$> const(PV "bar") s
243# 9 <1> leavesub[1 ref] K/REFC,1
244EONT_EONT
245
246pass ("FOREACH");
247
248checkOptree ( name => '-exec sub { foreach (1..10) {print "foo $_"} }',
249 code => sub { foreach (1..10) {print "foo $_"} },
250 bcopts => '-exec',
251 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
252# 1 <;> nextstate(main 443 optree.t:158) v
253# 2 <0> pushmark s
254# 3 <$> const[IV 1] s
255# 4 <$> const[IV 10] s
256# 5 <#> gv[*_] s
257# 6 <{> enteriter(next->d last->g redo->7) lKS
258# e <0> iter s
259# f <|> and(other->7) K/1
260# 7 <;> nextstate(main 442 optree.t:158) v
261# 8 <0> pushmark s
262# 9 <$> const[PV "foo "] s
263# a <#> gvsv[*_] s
264# b <2> concat[t4] sK/2
265# c <@> print vK
266# d <0> unstack s
267# goto e
268# g <2> leaveloop K/2
269# h <1> leavesub[1 ref] K/REFC,1
270# '
271EOT_EOT
272# 1 <;> nextstate(main 444 optree_samples.t:182) v
273# 2 <0> pushmark s
274# 3 <$> const(IV 1) s
275# 4 <$> const(IV 10) s
276# 5 <$> gv(*_) s
277# 6 <{> enteriter(next->d last->g redo->7) lKS
278# e <0> iter s
279# f <|> and(other->7) K/1
280# 7 <;> nextstate(main 443 optree_samples.t:182) v
281# 8 <0> pushmark s
282# 9 <$> const(PV "foo ") s
283# a <$> gvsv(*_) s
284# b <2> concat[t3] sK/2
285# c <@> print vK
286# d <0> unstack s
287# goto e
288# g <2> leaveloop K/2
289# h <1> leavesub[1 ref] K/REFC,1
290EONT_EONT
291
292checkOptree ( name => '-basic sub { print "foo $_" foreach (1..10) }',
293 code => sub { print "foo $_" foreach (1..10) },
294 bcopts => '-basic',
295 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
296# h <1> leavesub[1 ref] K/REFC,1 ->(end)
297# - <@> lineseq KP ->h
298# 1 <;> nextstate(main 445 optree.t:167) v ->2
299# 2 <;> nextstate(main 445 optree.t:167) v ->3
300# g <2> leaveloop K/2 ->h
301# 7 <{> enteriter(next->d last->g redo->8) lKS ->e
302# - <0> ex-pushmark s ->3
303# - <1> ex-list lK ->6
304# 3 <0> pushmark s ->4
305# 4 <$> const[IV 1] s ->5
306# 5 <$> const[IV 10] s ->6
307# 6 <#> gv[*_] s ->7
308# - <1> null K/1 ->g
309# f <|> and(other->8) K/1 ->g
310# e <0> iter s ->f
311# - <@> lineseq sK ->-
312# c <@> print vK ->d
313# 8 <0> pushmark s ->9
314# - <1> ex-stringify sK/1 ->c
315# - <0> ex-pushmark s ->9
316# b <2> concat[t2] sK/2 ->c
317# 9 <$> const[PV "foo "] s ->a
318# - <1> ex-rv2sv sK/1 ->b
319# a <#> gvsv[*_] s ->b
320# d <0> unstack s ->e
321EOT_EOT
322# h <1> leavesub[1 ref] K/REFC,1 ->(end)
323# - <@> lineseq KP ->h
324# 1 <;> nextstate(main 446 optree_samples.t:192) v ->2
325# 2 <;> nextstate(main 446 optree_samples.t:192) v ->3
326# g <2> leaveloop K/2 ->h
327# 7 <{> enteriter(next->d last->g redo->8) lKS ->e
328# - <0> ex-pushmark s ->3
329# - <1> ex-list lK ->6
330# 3 <0> pushmark s ->4
331# 4 <$> const(IV 1) s ->5
332# 5 <$> const(IV 10) s ->6
333# 6 <$> gv(*_) s ->7
334# - <1> null K/1 ->g
335# f <|> and(other->8) K/1 ->g
336# e <0> iter s ->f
337# - <@> lineseq sK ->-
338# c <@> print vK ->d
339# 8 <0> pushmark s ->9
340# - <1> ex-stringify sK/1 ->c
341# - <0> ex-pushmark s ->9
342# b <2> concat[t1] sK/2 ->c
343# 9 <$> const(PV "foo ") s ->a
344# - <1> ex-rv2sv sK/1 ->b
345# a <$> gvsv(*_) s ->b
346# d <0> unstack s ->e
347EONT_EONT
348
498d59dd
SH
349checkOptree ( name => '-exec -e foreach (1..10) {print qq{foo $_}}',
350 prog => 'foreach (1..10) {print qq{foo $_}}',
724aa791
JC
351 bcopts => '-exec',
352 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
353# 1 <0> enter
354# 2 <;> nextstate(main 2 -e:1) v
355# 3 <0> pushmark s
356# 4 <$> const[IV 1] s
357# 5 <$> const[IV 10] s
358# 6 <#> gv[*_] s
359# 7 <{> enteriter(next->e last->h redo->8) lKS
360# f <0> iter s
361# g <|> and(other->8) vK/1
362# 8 <;> nextstate(main 1 -e:1) v
363# 9 <0> pushmark s
364# a <$> const[PV "foo "] s
365# b <#> gvsv[*_] s
366# c <2> concat[t4] sK/2
367# d <@> print vK
368# e <0> unstack v
369# goto f
370# h <2> leaveloop vK/2
371# i <@> leave[1 ref] vKP/REFC
372EOT_EOT
373# 1 <0> enter
374# 2 <;> nextstate(main 2 -e:1) v
375# 3 <0> pushmark s
376# 4 <$> const(IV 1) s
377# 5 <$> const(IV 10) s
378# 6 <$> gv(*_) s
379# 7 <{> enteriter(next->e last->h redo->8) lKS
380# f <0> iter s
381# g <|> and(other->8) vK/1
382# 8 <;> nextstate(main 1 -e:1) v
383# 9 <0> pushmark s
384# a <$> const(PV "foo ") s
385# b <$> gvsv(*_) s
386# c <2> concat[t3] sK/2
387# d <@> print vK
388# e <0> unstack v
389# goto f
390# h <2> leaveloop vK/2
391# i <@> leave[1 ref] vKP/REFC
392
393EONT_EONT
394
395checkOptree ( name => '-exec sub { print "foo $_" foreach (1..10) }',
396 code => sub { print "foo $_" foreach (1..10) },
397 bcopts => '-exec',
398 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
399# B::Concise::compile(CODE(0x8332b20))
400# goto -
401# 1 <;> nextstate(main 445 optree.t:167) v
402# 2 <;> nextstate(main 445 optree.t:167) v
403# 3 <0> pushmark s
404# 4 <$> const[IV 1] s
405# 5 <$> const[IV 10] s
406# 6 <#> gv[*_] s
407# 7 <{> enteriter(next->d last->g redo->8) lKS
408# e <0> iter s
409# f <|> and(other->8) K/1
410# 8 <0> pushmark s
411# 9 <$> const[PV "foo "] s
412# a <#> gvsv[*_] s
413# b <2> concat[t2] sK/2
414# c <@> print vK
415# d <0> unstack s
416# goto e
417# g <2> leaveloop K/2
418# h <1> leavesub[1 ref] K/REFC,1
419EOT_EOT
420# 1 <;> nextstate(main 447 optree_samples.t:252) v
421# 2 <;> nextstate(main 447 optree_samples.t:252) v
422# 3 <0> pushmark s
423# 4 <$> const(IV 1) s
424# 5 <$> const(IV 10) s
425# 6 <$> gv(*_) s
426# 7 <{> enteriter(next->d last->g redo->8) lKS
427# e <0> iter s
428# f <|> and(other->8) K/1
429# 8 <0> pushmark s
430# 9 <$> const(PV "foo ") s
431# a <$> gvsv(*_) s
432# b <2> concat[t1] sK/2
433# c <@> print vK
434# d <0> unstack s
435# goto e
436# g <2> leaveloop K/2
437# h <1> leavesub[1 ref] K/REFC,1
438EONT_EONT
439
498d59dd
SH
440checkOptree ( name => '-e use constant j => qq{junk}; print j',
441 prog => 'use constant j => qq{junk}; print j',
724aa791
JC
442 bcopts => '-exec',
443 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
444# 1 <0> enter
445# 2 <;> nextstate(main 71 -e:1) v
446# 3 <0> pushmark s
447# 4 <$> const[PV "junk"] s
448# 5 <@> print vK
449# 6 <@> leave[1 ref] vKP/REFC
450EOT_EOT
451# 1 <0> enter
452# 2 <;> nextstate(main 71 -e:1) v
453# 3 <0> pushmark s
454# 4 <$> const(PV "junk") s
455# 5 <@> print vK
456# 6 <@> leave[1 ref] vKP/REFC
457EONT_EONT
458
2ce64696
JC
459} # skip
460
724aa791
JC
461__END__
462
463#######################################################################
464
465checkOptree ( name => '-exec sub a { print (shift) ? "foo" : "bar" }',
466 code => sub { print (shift) ? "foo" : "bar" },
467 bcopts => '-exec',
468 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
469 insert threaded reference here
470EOT_EOT
471 insert non-threaded reference here
472EONT_EONT
473