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