This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Un-TODO some B tests
[perl5.git] / ext / B / t / optree_constants.t
CommitLineData
d51cf0c9
JC
1#!perl
2
3BEGIN {
4 if ($ENV{PERL_CORE}) {
5 chdir('t') if -d 't';
6 @INC = ('.', '../lib', '../ext/B/t');
7 } else {
8 unshift @INC, 't';
9 push @INC, "../../t";
10 }
11 require Config;
12 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
13 print "1..0 # Skip -- Perl configured without B module\n";
14 exit 0;
15 }
16 # require 'test.pl'; # now done by OptreeCheck
17}
18
19use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
20use Config;
21
f9f861ec 22my $tests = 30;
d51cf0c9
JC
23plan tests => $tests;
24SKIP: {
25skip "no perlio in this build", $tests unless $Config::Config{useperlio};
26
09337566
NC
27my @open_todo;
28sub open_todo {
29 if (((caller 0)[10]||{})->{open}) {
30 @open_todo = (skip => "\$^OPEN is set");
31 }
32}
33open_todo;
34
d51cf0c9
JC
35#################################
36
37use constant { # see also t/op/gv.t line 282
f9f861ec
JC
38 myaref => [ 1,2,3 ],
39 myfl => 1.414213,
40 myglob => \*STDIN,
41 myhref => { a => 1 },
42 myint => 42,
43 myrex => qr/foo/,
44 mystr => 'hithere',
45 mysub => \&ok,
46 myundef => undef,
47 myunsub => \&nosuch,
48};
49
50sub myyes() { 1==1 }
51sub myno () { return 1!=1 }
52sub pi () { 3.14159 };
53
54my $want = { # expected types, how value renders in-line, todos (maybe)
55 myfl => [ 'NV', myfl ],
56 myint => [ 'IV', myint ],
57 mystr => [ 'PV', '"'.mystr.'"' ],
58 myhref => [ 'RV', '\\\\HASH'],
59 myundef => [ 'NULL', ],
60 pi => [ 'NV', pi ],
7a92afd1
RGS
61 myaref => [ 'RV', '\\\\' ],
62 myglob => [ 'RV', '\\\\' ],
63 myrex => [ 'RV', '\\\\' ],
64 mysub => [ 'RV', '\\\\' ],
65 myunsub => [ 'RV', '\\\\' ],
f9f861ec
JC
66 # these are not inlined, at least not per BC::Concise
67 #myyes => [ 'RV', ],
68 #myno => [ 'RV', ],
d51cf0c9
JC
69};
70
71use constant WEEKDAYS
72 => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
73
74
d51cf0c9
JC
75$::{napier} = \2.71828; # counter-example (doesn't get optimized).
76eval "sub napier ();";
77
78
79# should be able to undefine constant::import here ???
80INIT {
81 # eval 'sub constant::import () {}';
82 # undef *constant::import::{CODE};
83};
84
85#################################
f9f861ec 86pass("RENDER CONSTANT SUBS RETURNING SCALARS");
2018a5c3 87
f9f861ec
JC
88for $func (sort keys %$want) {
89 # no strict 'refs'; # why not needed ?
90 checkOptree ( name => "$func() as a coderef",
91 code => \&{$func},
92 noanchors => 1,
93 expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
94 is a constant sub, optimized to a $want->{$func}[0]
2018a5c3 95EOT_EOT
f9f861ec 96 is a constant sub, optimized to a $want->{$func}[0]
d51cf0c9
JC
97EONT_EONT
98
f9f861ec 99}
d51cf0c9 100
f9f861ec 101pass("RENDER CALLS TO THOSE CONSTANT SUBS");
d51cf0c9 102
f9f861ec
JC
103for $func (sort keys %$want) {
104 # print "# doing $func\n";
105 checkOptree ( name => "call $func",
106 code => "$func",
107 ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
108 bc_opts => '-nobanner',
109 expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
d51cf0c9 1103 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 111- <\@> lineseq KP ->3
d51cf0c9 1121 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
f9f861ec 1132 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
d51cf0c9
JC
114EOT_EOT
1153 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 116- <\@> lineseq KP ->3
d51cf0c9 1171 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
f9f861ec 1182 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
d51cf0c9
JC
119EONT_EONT
120
f9f861ec 121}
d51cf0c9 122
f9f861ec
JC
123##############
124pass("MORE TESTS");
d51cf0c9 125
f9f861ec
JC
126checkOptree ( name => 'myyes() as coderef',
127 code => sub () { 1==1 },
2018a5c3
JC
128 noanchors => 1,
129 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec 130 is a constant sub, optimized to a SPECIAL
2018a5c3 131EOT_EOT
f9f861ec 132 is a constant sub, optimized to a SPECIAL
2018a5c3
JC
133EONT_EONT
134
135
f9f861ec
JC
136checkOptree ( name => 'myyes() as coderef',
137 code => 'sub a() { 1==1 }; print a',
2018a5c3
JC
138 noanchors => 1,
139 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec
JC
140# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
141# - <@> lineseq KP ->5
142# 1 <;> nextstate(main 810 (eval 47):1) v ->2
143# 4 <@> print sK ->5
144# 2 <0> pushmark s ->3
145# 3 <$> const[SPECIAL sv_yes] s ->4
2018a5c3 146EOT_EOT
f9f861ec
JC
147# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
148# - <@> lineseq KP ->5
149# 1 <;> nextstate(main 810 (eval 47):1) v ->2
150# 4 <@> print sK ->5
151# 2 <0> pushmark s ->3
152# 3 <$> const(SPECIAL sv_yes) s ->4
2018a5c3
JC
153EONT_EONT
154
d51cf0c9 155
f9f861ec
JC
156checkOptree ( name => 'myno() as coderef',
157 code => 'sub a() { 1!=1 }; print a',
d51cf0c9 158 noanchors => 1,
f9f861ec 159 todo => '- SPECIAL sv_no renders as PVNV 0',
d51cf0c9 160 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec
JC
161# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
162# - <@> lineseq KP ->5
163# 1 <;> nextstate(main 810 (eval 47):1) v ->2
164# 4 <@> print sK ->5
165# 2 <0> pushmark s ->3
166# 3 <$> const[PVNV 0] s ->4
d51cf0c9 167EOT_EOT
f9f861ec
JC
168# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
169# - <@> lineseq KP ->5
170# 1 <;> nextstate(main 810 (eval 47):1) v ->2
171# 4 <@> print sK ->5
172# 2 <0> pushmark s ->3
173# 3 <$> const(PVNV 0) s ->4
d51cf0c9
JC
174EONT_EONT
175
176
2018a5c3 177checkOptree ( name => 'constant sub returning list',
d51cf0c9
JC
178 code => \&WEEKDAYS,
179 noanchors => 1,
180 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
181# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
182# - <@> lineseq K ->3
d5ec2987 183# 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
d51cf0c9
JC
184# 2 <0> padav[@list:FAKE:m:102] ->3
185EOT_EOT
186# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
187# - <@> lineseq K ->3
d5ec2987 188# 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
d51cf0c9
JC
189# 2 <0> padav[@list:FAKE:m:76] ->3
190EONT_EONT
191
192
193sub printem {
194 printf "myint %d mystr %s myfl %f pi %f\n"
195 , myint, mystr, myfl, pi;
196}
197
2018a5c3 198checkOptree ( name => 'call many in a print statement',
d51cf0c9 199 code => \&printem,
09337566 200 @open_todo,
d51cf0c9
JC
201 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
202# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
203# - <@> lineseq KP ->9
204# 1 <;> nextstate(main 635 optree_constants.t:163) v ->2
205# 8 <@> prtf sK ->9
206# 2 <0> pushmark s ->3
207# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
208# 4 <$> const[IV 42] s ->5
209# 5 <$> const[PV "hithere"] s ->6
f9f861ec 210# 6 <$> const[NV 1.414213] s ->7
d51cf0c9
JC
211# 7 <$> const[NV 3.14159] s ->8
212EOT_EOT
213# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
214# - <@> lineseq KP ->9
215# 1 <;> nextstate(main 635 optree_constants.t:163) v ->2
216# 8 <@> prtf sK ->9
217# 2 <0> pushmark s ->3
218# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
219# 4 <$> const(IV 42) s ->5
220# 5 <$> const(PV "hithere") s ->6
f9f861ec 221# 6 <$> const(NV 1.414213) s ->7
d51cf0c9
JC
222# 7 <$> const(NV 3.14159) s ->8
223EONT_EONT
224
225
226} #skip
227
228__END__
229
230=head NB
231
232Optimized constant subs are stored as bare scalars in the stash
233(package hash), which formerly held only GVs (typeglobs).
234
235But you cant create them manually - you cant assign a scalar to a
236stash element, and expect it to work like a constant-sub, even if you
237provide a prototype.
238
239This is a feature; alternative is too much action-at-a-distance. The
240following test demonstrates - napier is not seen as a function at all,
241much less an optimized one.
242
243=cut
244
245checkOptree ( name => 'not evertnapier',
246 code => \&napier,
247 noanchors => 1,
248 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
249 has no START
250EOT_EOT
251 has no START
252EONT_EONT
253
254