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