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