This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bump $Time::HiRes::VERSION
[perl5.git] / ext / B / t / optree_constants.t
1 #!perl
2
3 BEGIN {
4     unshift @INC, 't';
5     require Config;
6     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
7         print "1..0 # Skip -- Perl configured without B module\n";
8         exit 0;
9     }
10     if (!$Config::Config{useperlio}) {
11         print "1..0 # Skip -- need perlio to walk the optree\n";
12         exit 0;
13     }
14 }
15
16 use OptreeCheck;        # ALSO DOES @ARGV HANDLING !!!!!!
17 use Config;
18
19 plan tests => 99;
20
21 #################################
22
23 my sub lleexx {}
24 sub tsub0 {}
25 sub tsub1 {} $tsub1 = 1;
26 sub t::tsub2 {}
27 sub t::tsub3 {} $tsub3 = 1;
28 {
29     package t;
30     sub tsub4 {}
31     sub tsub5 {} $tsub5 = 1;
32 }
33
34 use constant {          # see also t/op/gv.t line 358
35     myaref      => [ 1,2,3 ],
36     myfl        => 1.414213,
37     myglob      => \*STDIN,
38     myhref      => { a  => 1 },
39     myint       => 42,
40     myrex       => qr/foo/,
41     mystr       => 'hithere',
42     mysub       => \&ok,
43     myundef     => undef,
44     myunsub     => \&nosuch,
45     myanonsub   => sub {},
46     mylexsub    => \&lleexx,
47     tsub0       => \&tsub0,
48     tsub1       => \&tsub1,
49     tsub2       => \&t::tsub2,
50     tsub3       => \&t::tsub3,
51     tsub4       => \&t::tsub4,
52     tsub5       => \&t::tsub5,
53 };
54
55 sub myyes() { 1==1 }
56 sub myno () { return 1!=1 }
57 sub pi () { 3.14159 };
58
59 my $want = {    # expected types, how value renders in-line, todos (maybe)
60     mystr       => [ 'PV', '"'.mystr.'"' ],
61     myhref      => [ 'IV', '\\\\HASH'],
62     pi          => [ 'NV', pi ],
63     myglob      => [ 'IV', '\\\\' ],
64     mysub       => [ 'IV', '\\\\&main::ok' ],
65     myunsub     => [ 'IV', '\\\\&main::nosuch' ],
66     myanonsub   => [ 'IV', '\\\\CODE' ],
67     mylexsub    => [ 'IV', '\\\\&lleexx' ],
68     tsub0       => [ 'IV', '\\\\&main::tsub0' ],
69     tsub1       => [ 'IV', '\\\\&main::tsub1' ],
70     tsub2       => [ 'IV', '\\\\&t::tsub2' ],
71     tsub3       => [ 'IV', '\\\\&t::tsub3' ],
72     tsub4       => [ 'IV', '\\\\&t::tsub4' ],
73     tsub5       => [ 'IV', '\\\\&t::tsub5' ],
74     # these are not inlined, at least not per BC::Concise
75     #myyes      => [ 'IV', ],
76     #myno       => [ 'IV', ],
77     myaref      => [ 'IV', '\\\\ARRAY' ],
78     myfl        => [ 'NV', myfl ],
79     myint       => [ 'IV', myint ],
80     myrex       => [ 'IV', '\\\\"\\(?^:Foo\\)"' ],
81     myundef     => [ 'NULL', ],
82 };
83
84 use constant WEEKDAYS
85     => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
86
87
88 $::{napier} = \2.71828; # counter-example (doesn't get optimized).
89 eval "sub napier ();";
90
91
92 # should be able to undefine constant::import here ???
93 INIT { 
94     # eval 'sub constant::import () {}';
95     # undef *constant::import::{CODE};
96 };
97
98 #################################
99 pass("RENDER CONSTANT SUBS RETURNING SCALARS");
100
101 for $func (sort keys %$want) {
102     # no strict 'refs'; # why not needed ?
103     checkOptree ( name      => "$func() as a coderef",
104                   code      => \&{$func},
105                   noanchors => 1,
106                   expect    => <<EOT_EOT, expect_nt => <<EONT_EONT);
107  is a constant sub, optimized to a $want->{$func}[0]
108 EOT_EOT
109  is a constant sub, optimized to a $want->{$func}[0]
110 EONT_EONT
111
112 }
113
114 pass("RENDER CALLS TO THOSE CONSTANT SUBS");
115
116 for $func (sort keys %$want) {
117     # print "# doing $func\n";
118     checkOptree ( name    => "call $func",
119                   code    => "$func",
120                   ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
121                   bc_opts => '-nobanner',
122                   expect  => <<EOT_EOT, expect_nt => <<EONT_EONT);
123 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
124 -     <\@> lineseq KP ->3
125 1        <;> dbstate(main 833 (eval 44):1) v ->2
126 2        <\$> const[$want->{$func}[0] $want->{$func}[1]] s*/FOLD ->3
127 EOT_EOT
128 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
129 -     <\@> lineseq KP ->3
130 1        <;> dbstate(main 833 (eval 44):1) v ->2
131 2        <\$> const($want->{$func}[0] $want->{$func}[1]) s*/FOLD ->3
132 EONT_EONT
133
134 }
135
136 ##############
137 pass("MORE TESTS");
138
139 checkOptree ( name      => 'myyes() as coderef',
140               code      => sub () { 1==1 },
141               noanchors => 1,
142               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
143  is a constant sub, optimized to a SPECIAL
144 EOT_EOT
145  is a constant sub, optimized to a SPECIAL
146 EONT_EONT
147
148
149 checkOptree ( name      => 'myyes() as coderef',
150               prog      => 'sub a() { 1==1 }; print a',
151               noanchors => 1,
152               strip_open_hints => 1,
153               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
154 # 6  <@> leave[1 ref] vKP/REFC ->(end)
155 # 1     <0> enter ->2
156 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
157 # 5     <@> print vK ->6
158 # 3        <0> pushmark s ->4
159 # 4        <$> const[SPECIAL sv_yes] s*/FOLD ->5
160 EOT_EOT
161 # 6  <@> leave[1 ref] vKP/REFC ->(end)
162 # 1     <0> enter ->2
163 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
164 # 5     <@> print vK ->6
165 # 3        <0> pushmark s ->4
166 # 4        <$> const(SPECIAL sv_yes) s*/FOLD ->5
167 EONT_EONT
168
169
170 # Need to do this as a prog, not code, as only the first constant to use
171 # PL_sv_no actually gets to use the real thing - every one following is
172 # copied.
173 checkOptree ( name      => 'myno() as coderef',
174               prog      => 'sub a() { 1!=1 }; print a',
175               noanchors => 1,
176               strip_open_hints => 1,
177               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
178 # 6  <@> leave[1 ref] vKP/REFC ->(end)
179 # 1     <0> enter ->2
180 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
181 # 5     <@> print vK ->6
182 # 3        <0> pushmark s ->4
183 # 4        <$> const[SPECIAL sv_no] s*/FOLD ->5
184 EOT_EOT
185 # 6  <@> leave[1 ref] vKP/REFC ->(end)
186 # 1     <0> enter ->2
187 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
188 # 5     <@> print vK ->6
189 # 3        <0> pushmark s ->4
190 # 4        <$> const(SPECIAL sv_no) s*/FOLD ->5
191 EONT_EONT
192
193
194 my ($expect, $expect_nt) = (" is a constant sub, optimized to a AV\n") x 2;
195
196
197 checkOptree ( name      => 'constant sub returning list',
198               code      => \&WEEKDAYS,
199               noanchors => 1,
200               expect => $expect, expect_nt => $expect_nt);
201
202
203 sub printem {
204     printf "myint %d mystr %s myfl %f pi %f\n"
205         , myint, mystr, myfl, pi;
206 }
207
208 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
209 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
210 # -     <@> lineseq KP ->9
211 # 1        <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
212 # 8        <@> prtf sK ->9
213 # 2           <0> pushmark sM ->3
214 # 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM/FOLD ->4
215 # 4           <$> const[IV 42] sM*/FOLD ->5
216 # 5           <$> const[PV "hithere"] sM*/FOLD ->6
217 # 6           <$> const[NV 1.414213] sM*/FOLD ->7
218 # 7           <$> const[NV 3.14159] sM*/FOLD ->8
219 EOT_EOT
220 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
221 # -     <@> lineseq KP ->9
222 # 1        <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
223 # 8        <@> prtf sK ->9
224 # 2           <0> pushmark sM ->3
225 # 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM/FOLD ->4
226 # 4           <$> const(IV 42) sM*/FOLD ->5
227 # 5           <$> const(PV "hithere") sM*/FOLD ->6
228 # 6           <$> const(NV 1.414213) sM*/FOLD ->7
229 # 7           <$> const(NV 3.14159) sM*/FOLD ->8
230 EONT_EONT
231
232 s|\\n"[])] sM\K/FOLD|| for $expect, $expect_nt;
233
234 checkOptree ( name      => 'call many in a print statement',
235               code      => \&printem,
236               strip_open_hints => 1,
237               expect => $expect, expect_nt => $expect_nt);
238
239 # test constant expression folding
240
241 checkOptree ( name      => 'arithmetic constant folding in print',
242               code      => 'print 1+2+3',
243               strip_open_hints => 1,
244               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
245 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
246 # -     <@> lineseq KP ->5
247 # 1        <;> nextstate(main 937 (eval 53):1) v ->2
248 # 4        <@> print sK ->5
249 # 2           <0> pushmark s ->3
250 # 3           <$> const[IV 6] s/FOLD ->4
251 EOT_EOT
252 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
253 # -     <@> lineseq KP ->5
254 # 1        <;> nextstate(main 937 (eval 53):1) v ->2
255 # 4        <@> print sK ->5
256 # 2           <0> pushmark s ->3
257 # 3           <$> const(IV 6) s/FOLD ->4
258 EONT_EONT
259
260 checkOptree ( name      => 'string constant folding in print',
261               code      => 'print "foo"."bar"',
262               strip_open_hints => 1,
263               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
264 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
265 # -     <@> lineseq KP ->5
266 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
267 # 4        <@> print sK ->5
268 # 2           <0> pushmark s ->3
269 # 3           <$> const[PV "foobar"] s/FOLD ->4
270 EOT_EOT
271 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
272 # -     <@> lineseq KP ->5
273 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
274 # 4        <@> print sK ->5
275 # 2           <0> pushmark s ->3
276 # 3           <$> const(PV "foobar") s/FOLD ->4
277 EONT_EONT
278
279 checkOptree ( name      => 'boolean or folding',
280               code      => 'print "foobar" if 1 or 0',
281               strip_open_hints => 1,
282               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
283 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
284 # -     <@> lineseq KP ->5
285 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
286 # 4        <@> print sK/FOLD ->5
287 # 2           <0> pushmark s ->3
288 # 3           <$> const[PV "foobar"] s ->4
289 EOT_EOT
290 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
291 # -     <@> lineseq KP ->5
292 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
293 # 4        <@> print sK/FOLD ->5
294 # 2           <0> pushmark s ->3
295 # 3           <$> const(PV "foobar") s ->4
296 EONT_EONT
297
298 checkOptree ( name      => 'lc*,uc*,gt,lt,ge,le,cmp',
299               code      => sub {
300                   $s = uc('foo.').ucfirst('bar.').lc('LOW.').lcfirst('LOW');
301                   print "a-lt-b" if "a" lt "b";
302                   print "b-gt-a" if "b" gt "a";
303                   print "a-le-b" if "a" le "b";
304                   print "b-ge-a" if "b" ge "a";
305                   print "b-cmp-a" if "b" cmp "a";
306                   print "a-gt-b" if "a" gt "b"; # should be suppressed
307               },
308               strip_open_hints => 1,
309               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
310 # r  <1> leavesub[1 ref] K/REFC,1 ->(end)
311 # -     <@> lineseq KP ->r
312 # 1        <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
313 # 4        <2> sassign vKS/2 ->5
314 # 2           <$> const[PV "FOO.Bar.low.lOW"] s/FOLD ->3
315 # -           <1> ex-rv2sv sKRM*/1 ->4
316 # 3              <#> gvsv[*s] s ->4
317 # 5        <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
318 # 8        <@> print vK/FOLD ->9
319 # 6           <0> pushmark s ->7
320 # 7           <$> const[PV "a-lt-b"] s ->8
321 # 9        <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
322 # c        <@> print vK/FOLD ->d
323 # a           <0> pushmark s ->b
324 # b           <$> const[PV "b-gt-a"] s ->c
325 # d        <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
326 # g        <@> print vK/FOLD ->h
327 # e           <0> pushmark s ->f
328 # f           <$> const[PV "a-le-b"] s ->g
329 # h        <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
330 # k        <@> print vK/FOLD ->l
331 # i           <0> pushmark s ->j
332 # j           <$> const[PV "b-ge-a"] s ->k
333 # l        <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
334 # o        <@> print vK/FOLD ->p
335 # m           <0> pushmark s ->n
336 # n           <$> const[PV "b-cmp-a"] s ->o
337 # p        <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
338 # q        <$> const[SPECIAL sv_no] s/SHORT,FOLD ->r
339 EOT_EOT
340 # r  <1> leavesub[1 ref] K/REFC,1 ->(end)
341 # -     <@> lineseq KP ->r
342 # 1        <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
343 # 4        <2> sassign vKS/2 ->5
344 # 2           <$> const(PV "FOO.Bar.low.lOW") s/FOLD ->3
345 # -           <1> ex-rv2sv sKRM*/1 ->4
346 # 3              <$> gvsv(*s) s ->4
347 # 5        <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
348 # 8        <@> print vK/FOLD ->9
349 # 6           <0> pushmark s ->7
350 # 7           <$> const(PV "a-lt-b") s ->8
351 # 9        <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
352 # c        <@> print vK/FOLD ->d
353 # a           <0> pushmark s ->b
354 # b           <$> const(PV "b-gt-a") s ->c
355 # d        <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
356 # g        <@> print vK/FOLD ->h
357 # e           <0> pushmark s ->f
358 # f           <$> const(PV "a-le-b") s ->g
359 # h        <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
360 # k        <@> print vK/FOLD ->l
361 # i           <0> pushmark s ->j
362 # j           <$> const(PV "b-ge-a") s ->k
363 # l        <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
364 # o        <@> print vK/FOLD ->p
365 # m           <0> pushmark s ->n
366 # n           <$> const(PV "b-cmp-a") s ->o
367 # p        <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
368 # q        <$> const(SPECIAL sv_no) s/SHORT,FOLD ->r
369 EONT_EONT
370
371 checkOptree ( name      => 'mixed constant folding, with explicit braces',
372               code      => 'print "foo"."bar".(2+3)',
373               strip_open_hints => 1,
374               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
375 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
376 # -     <@> lineseq KP ->5
377 # 1        <;> nextstate(main 977 (eval 28):1) v ->2
378 # 4        <@> print sK ->5
379 # 2           <0> pushmark s ->3
380 # 3           <$> const[PV "foobar5"] s/FOLD ->4
381 EOT_EOT
382 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
383 # -     <@> lineseq KP ->5
384 # 1        <;> nextstate(main 977 (eval 28):1) v ->2
385 # 4        <@> print sK ->5
386 # 2           <0> pushmark s ->3
387 # 3           <$> const(PV "foobar5") s/FOLD ->4
388 EONT_EONT
389
390 __END__
391
392 =head NB
393
394 Optimized constant subs are stored as bare scalars in the stash
395 (package hash), which formerly held only GVs (typeglobs).
396
397 But you cant create them manually - you cant assign a scalar to a
398 stash element, and expect it to work like a constant-sub, even if you
399 provide a prototype.
400
401 This is a feature; alternative is too much action-at-a-distance.  The
402 following test demonstrates - napier is not seen as a function at all,
403 much less an optimized one.
404
405 =cut
406
407 checkOptree ( name      => 'not evertnapier',
408               code      => \&napier,
409               noanchors => 1,
410               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
411  has no START
412 EOT_EOT
413  has no START
414 EONT_EONT
415
416