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