This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
d08c6be93d283328668ed774d2a5d673309e101c
[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) = (<<'EOT_EOT', <<'EONT_EONT');
180 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
181 # -     <@> lineseq K ->3
182 # 1        <;> nextstate(constant 61 constant.pm:118) v:*,&,x*,x&,x$ ->2
183 # 2        <0> padav[@list:FAKE:m:96] ->3
184 EOT_EOT
185 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
186 # -     <@> lineseq K ->3
187 # 1        <;> nextstate(constant 61 constant.pm:118) v:*,&,x*,x&,x$ ->2
188 # 2        <0> padav[@list:FAKE:m:71] ->3
189 EONT_EONT
190
191
192 checkOptree ( name      => 'constant sub returning list',
193               code      => \&WEEKDAYS,
194               noanchors => 1,
195               expect => $expect, expect_nt => $expect_nt);
196
197
198 sub printem {
199     printf "myint %d mystr %s myfl %f pi %f\n"
200         , myint, mystr, myfl, pi;
201 }
202
203 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
204 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
205 # -     <@> lineseq KP ->9
206 # 1        <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
207 # 8        <@> prtf sK ->9
208 # 2           <0> pushmark sM ->3
209 # 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM ->4 < 5.017002
210 # 4           <$> const[IV 42] sM* ->5          < 5.017002
211 # 5           <$> const[PV "hithere"] sM* ->6   < 5.017002
212 # 6           <$> const[NV 1.414213] sM* ->7    < 5.017002
213 # 7           <$> const[NV 3.14159] sM* ->8     < 5.017002
214 # 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM/FOLD ->4 >= 5.017002
215 # 4           <$> const[IV 42] sM*/FOLD ->5          >=5.017002 
216 # 5           <$> const[PV "hithere"] sM*/FOLD ->6   >=5.017002
217 # 6           <$> const[NV 1.414213] sM*/FOLD ->7    >=5.017002
218 # 7           <$> const[NV 3.14159] sM*/FOLD ->8     >=5.017002
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 ->4 < 5.017002
226 # 4           <$> const(IV 42) sM* ->5          < 5.017002
227 # 5           <$> const(PV "hithere") sM* ->6   < 5.017002
228 # 6           <$> const(NV 1.414213) sM* ->7    < 5.017002
229 # 7           <$> const(NV 3.14159) sM* ->8     < 5.017002
230 # 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM/FOLD ->4 >= 5.017002
231 # 4           <$> const(IV 42) sM*/FOLD ->5          >=5.017002 
232 # 5           <$> const(PV "hithere") sM*/FOLD ->6   >=5.017002
233 # 6           <$> const(NV 1.414213) sM*/FOLD ->7    >=5.017002
234 # 7           <$> const(NV 3.14159) sM*/FOLD ->8     >=5.017002
235 EONT_EONT
236
237 if($] < 5.015) {
238     s/M(?=\*? ->)//g for $expect, $expect_nt;
239 }
240
241 checkOptree ( name      => 'call many in a print statement',
242               code      => \&printem,
243               strip_open_hints => 1,
244               expect => $expect, expect_nt => $expect_nt);
245
246 # test constant expression folding
247
248 checkOptree ( name      => 'arithmetic constant folding in print',
249               code      => 'print 1+2+3',
250               strip_open_hints => 1,
251               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
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 ->4      < 5.017002
258 # 3           <$> const[IV 6] s/FOLD ->4 >=5.017002
259 EOT_EOT
260 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
261 # -     <@> lineseq KP ->5
262 # 1        <;> nextstate(main 937 (eval 53):1) v ->2
263 # 4        <@> print sK ->5
264 # 2           <0> pushmark s ->3
265 # 3           <$> const(IV 6) s ->4      < 5.017002
266 # 3           <$> const(IV 6) s/FOLD ->4 >=5.017002
267 EONT_EONT
268
269 checkOptree ( name      => 'string constant folding in print',
270               code      => 'print "foo"."bar"',
271               strip_open_hints => 1,
272               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
273 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
274 # -     <@> lineseq KP ->5
275 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
276 # 4        <@> print sK ->5
277 # 2           <0> pushmark s ->3
278 # 3           <$> const[PV "foobar"] s ->4      < 5.017002
279 # 3           <$> const[PV "foobar"] s/FOLD ->4 >=5.017002
280 EOT_EOT
281 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
282 # -     <@> lineseq KP ->5
283 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
284 # 4        <@> print sK ->5
285 # 2           <0> pushmark s ->3
286 # 3           <$> const(PV "foobar") s ->4      < 5.017002
287 # 3           <$> const(PV "foobar") s/FOLD ->4 >=5.017002
288 EONT_EONT
289
290 checkOptree ( name      => 'boolean or folding',
291               code      => 'print "foobar" if 1 or 0',
292               strip_open_hints => 1,
293               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
294 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
295 # -     <@> lineseq KP ->5
296 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
297 # 4        <@> print sK ->5
298 # 2           <0> pushmark s ->3
299 # 3           <$> const[PV "foobar"] s ->4
300 EOT_EOT
301 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
302 # -     <@> lineseq KP ->5
303 # 1        <;> nextstate(main 942 (eval 55):1) v ->2
304 # 4        <@> print sK ->5
305 # 2           <0> pushmark s ->3
306 # 3           <$> const(PV "foobar") s ->4
307 EONT_EONT
308
309 checkOptree ( name      => 'lc*,uc*,gt,lt,ge,le,cmp',
310               code      => sub {
311                   $s = uc('foo.').ucfirst('bar.').lc('LOW.').lcfirst('LOW');
312                   print "a-lt-b" if "a" lt "b";
313                   print "b-gt-a" if "b" gt "a";
314                   print "a-le-b" if "a" le "b";
315                   print "b-ge-a" if "b" ge "a";
316                   print "b-cmp-a" if "b" cmp "a";
317                   print "a-gt-b" if "a" gt "b"; # should be suppressed
318               },
319               strip_open_hints => 1,
320               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
321 # r  <1> leavesub[1 ref] K/REFC,1 ->(end)
322 # -     <@> lineseq KP ->r
323 # 1        <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
324 # 4        <2> sassign vKS/2 ->5
325 # 2           <$> const[PV "FOO.Bar.low.lOW"] s ->3      < 5.017002
326 # 2           <$> const[PV "FOO.Bar.low.lOW"] s/FOLD ->3 >=5.017002
327 # -           <1> ex-rv2sv sKRM*/1 ->4
328 # 3              <#> gvsv[*s] s ->4
329 # 5        <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
330 # 8        <@> print vK ->9
331 # 6           <0> pushmark s ->7
332 # 7           <$> const[PV "a-lt-b"] s ->8
333 # 9        <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
334 # c        <@> print vK ->d
335 # a           <0> pushmark s ->b
336 # b           <$> const[PV "b-gt-a"] s ->c
337 # d        <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
338 # g        <@> print vK ->h
339 # e           <0> pushmark s ->f
340 # f           <$> const[PV "a-le-b"] s ->g
341 # h        <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
342 # k        <@> print vK ->l
343 # i           <0> pushmark s ->j
344 # j           <$> const[PV "b-ge-a"] s ->k
345 # l        <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
346 # o        <@> print vK ->p
347 # m           <0> pushmark s ->n
348 # n           <$> const[PV "b-cmp-a"] s ->o
349 # p        <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
350 # q        <$> const[PVNV 0] s/SHORT ->r      < 5.017002
351 # q        <$> const[PVNV 0] s/FOLD,SHORT ->r >=5.017002 < 5.019001
352 # q        <$> const[SPECIAL sv_no] s/FOLD,SHORT ->r >=5.019001
353 EOT_EOT
354 # r  <1> leavesub[1 ref] K/REFC,1 ->(end)
355 # -     <@> lineseq KP ->r
356 # 1        <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
357 # 4        <2> sassign vKS/2 ->5
358 # 2           <$> const(PV "FOO.Bar.low.lOW") s ->3      < 5.017002
359 # 2           <$> const(PV "FOO.Bar.low.lOW") s/FOLD ->3 >=5.017002
360 # -           <1> ex-rv2sv sKRM*/1 ->4
361 # 3              <$> gvsv(*s) s ->4
362 # 5        <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
363 # 8        <@> print vK ->9
364 # 6           <0> pushmark s ->7
365 # 7           <$> const(PV "a-lt-b") s ->8
366 # 9        <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
367 # c        <@> print vK ->d
368 # a           <0> pushmark s ->b
369 # b           <$> const(PV "b-gt-a") s ->c
370 # d        <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
371 # g        <@> print vK ->h
372 # e           <0> pushmark s ->f
373 # f           <$> const(PV "a-le-b") s ->g
374 # h        <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
375 # k        <@> print vK ->l
376 # i           <0> pushmark s ->j
377 # j           <$> const(PV "b-ge-a") s ->k
378 # l        <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
379 # o        <@> print vK ->p
380 # m           <0> pushmark s ->n
381 # n           <$> const(PV "b-cmp-a") s ->o
382 # p        <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
383 # q        <$> const(SPECIAL sv_no) s/SHORT ->r      < 5.017002
384 # q        <$> const(SPECIAL sv_no) s/FOLD,SHORT ->r >=5.017002
385 EONT_EONT
386
387 checkOptree ( name      => 'mixed constant folding, with explicit braces',
388               code      => 'print "foo"."bar".(2+3)',
389               strip_open_hints => 1,
390               expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
391 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
392 # -     <@> lineseq KP ->5
393 # 1        <;> nextstate(main 977 (eval 28):1) v ->2
394 # 4        <@> print sK ->5
395 # 2           <0> pushmark s ->3
396 # 3           <$> const[PV "foobar5"] s ->4      < 5.017002
397 # 3           <$> const[PV "foobar5"] s/FOLD ->4 >=5.017002
398 EOT_EOT
399 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
400 # -     <@> lineseq KP ->5
401 # 1        <;> nextstate(main 977 (eval 28):1) v ->2
402 # 4        <@> print sK ->5
403 # 2           <0> pushmark s ->3
404 # 3           <$> const(PV "foobar5") s ->4      < 5.017002
405 # 3           <$> const(PV "foobar5") s/FOLD ->4 >=5.017002
406 EONT_EONT
407
408 __END__
409
410 =head NB
411
412 Optimized constant subs are stored as bare scalars in the stash
413 (package hash), which formerly held only GVs (typeglobs).
414
415 But you cant create them manually - you cant assign a scalar to a
416 stash element, and expect it to work like a constant-sub, even if you
417 provide a prototype.
418
419 This is a feature; alternative is too much action-at-a-distance.  The
420 following test demonstrates - napier is not seen as a function at all,
421 much less an optimized one.
422
423 =cut
424
425 checkOptree ( name      => 'not evertnapier',
426               code      => \&napier,
427               noanchors => 1,
428               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
429  has no START
430 EOT_EOT
431  has no START
432 EONT_EONT
433
434