This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Tweak optree_constants.t for inlined list consts
[perl5.git] / ext / B / t / optree_constants.t
CommitLineData
d51cf0c9
JC
1#!perl
2
3BEGIN {
74517a3a 4 unshift @INC, 't';
d51cf0c9
JC
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 }
27e11f68
NC
10 if (!$Config::Config{useperlio}) {
11 print "1..0 # Skip -- need perlio to walk the optree\n";
12 exit 0;
13 }
d51cf0c9
JC
14}
15
16use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
17use Config;
18
183eb698 19plan tests => 67;
d51cf0c9
JC
20
21#################################
22
609d3913 23use constant { # see also t/op/gv.t line 358
f9f861ec
JC
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
36sub myyes() { 1==1 }
37sub myno () { return 1!=1 }
38sub pi () { 3.14159 };
39
4df7f6af
NC
40my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
41
f9f861ec 42my $want = { # expected types, how value renders in-line, todos (maybe)
f9f861ec 43 mystr => [ 'PV', '"'.mystr.'"' ],
4df7f6af 44 myhref => [ $RV_class, '\\\\HASH'],
f9f861ec 45 pi => [ 'NV', pi ],
4df7f6af
NC
46 myglob => [ $RV_class, '\\\\' ],
47 mysub => [ $RV_class, '\\\\' ],
48 myunsub => [ $RV_class, '\\\\' ],
f9f861ec 49 # these are not inlined, at least not per BC::Concise
4df7f6af
NC
50 #myyes => [ $RV_class, ],
51 #myno => [ $RV_class, ],
4df7f6af 52 myaref => [ $RV_class, '\\\\' ],
e412117e
NC
53 myfl => [ 'NV', myfl ],
54 myint => [ 'IV', myint ],
f7c278bf 55 $] >= 5.011 ? (
4c2c679f 56 myrex => [ $RV_class, '\\\\"\\(?^:Foo\\)"' ],
f7c278bf 57 ) : (
4df7f6af 58 myrex => [ $RV_class, '\\\\' ],
f7c278bf 59 ),
e412117e 60 myundef => [ 'NULL', ],
d51cf0c9
JC
61};
62
63use constant WEEKDAYS
64 => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
65
66
d51cf0c9
JC
67$::{napier} = \2.71828; # counter-example (doesn't get optimized).
68eval "sub napier ();";
69
70
71# should be able to undefine constant::import here ???
72INIT {
73 # eval 'sub constant::import () {}';
74 # undef *constant::import::{CODE};
75};
76
77#################################
f9f861ec 78pass("RENDER CONSTANT SUBS RETURNING SCALARS");
2018a5c3 79
f9f861ec
JC
80for $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]
2018a5c3 87EOT_EOT
f9f861ec 88 is a constant sub, optimized to a $want->{$func}[0]
d51cf0c9
JC
89EONT_EONT
90
f9f861ec 91}
d51cf0c9 92
f9f861ec 93pass("RENDER CALLS TO THOSE CONSTANT SUBS");
d51cf0c9 94
f9f861ec
JC
95for $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);
d51cf0c9 1023 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 103- <\@> lineseq KP ->3
d1718a7c 1041 <;> dbstate(main 833 (eval 44):1) v ->2
82aeefe1
DM
1052 <\$> const[$want->{$func}[0] $want->{$func}[1]] s* ->3 < 5.017002
1062 <\$> const[$want->{$func}[0] $want->{$func}[1]] s*/FOLD ->3 >=5.017002
d51cf0c9
JC
107EOT_EOT
1083 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 109- <\@> lineseq KP ->3
d1718a7c 1101 <;> dbstate(main 833 (eval 44):1) v ->2
82aeefe1
DM
1112 <\$> const($want->{$func}[0] $want->{$func}[1]) s* ->3 < 5.017002
1122 <\$> const($want->{$func}[0] $want->{$func}[1]) s*/FOLD ->3 >=5.017002
d51cf0c9
JC
113EONT_EONT
114
f9f861ec 115}
d51cf0c9 116
f9f861ec
JC
117##############
118pass("MORE TESTS");
d51cf0c9 119
f9f861ec
JC
120checkOptree ( name => 'myyes() as coderef',
121 code => sub () { 1==1 },
2018a5c3
JC
122 noanchors => 1,
123 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec 124 is a constant sub, optimized to a SPECIAL
2018a5c3 125EOT_EOT
f9f861ec 126 is a constant sub, optimized to a SPECIAL
2018a5c3
JC
127EONT_EONT
128
129
f9f861ec 130checkOptree ( name => 'myyes() as coderef',
36932700 131 prog => 'sub a() { 1==1 }; print a',
2018a5c3 132 noanchors => 1,
e412117e 133 strip_open_hints => 1,
2018a5c3 134 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36932700
NC
135# 6 <@> leave[1 ref] vKP/REFC ->(end)
136# 1 <0> enter ->2
e412117e 137# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
138# 5 <@> print vK ->6
139# 3 <0> pushmark s ->4
82aeefe1
DM
140# 4 <$> const[SPECIAL sv_yes] s* ->5 < 5.017002
141# 4 <$> const[SPECIAL sv_yes] s*/FOLD ->5 >=5.017002
2018a5c3 142EOT_EOT
36932700
NC
143# 6 <@> leave[1 ref] vKP/REFC ->(end)
144# 1 <0> enter ->2
e412117e 145# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
146# 5 <@> print vK ->6
147# 3 <0> pushmark s ->4
82aeefe1
DM
148# 4 <$> const(SPECIAL sv_yes) s* ->5 < 5.017002
149# 4 <$> const(SPECIAL sv_yes) s*/FOLD ->5 >=5.017002
2018a5c3
JC
150EONT_EONT
151
d51cf0c9 152
36932700
NC
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.
f9f861ec 156checkOptree ( name => 'myno() as coderef',
36932700 157 prog => 'sub a() { 1!=1 }; print a',
d51cf0c9 158 noanchors => 1,
e412117e 159 strip_open_hints => 1,
d51cf0c9 160 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36932700
NC
161# 6 <@> leave[1 ref] vKP/REFC ->(end)
162# 1 <0> enter ->2
e412117e 163# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
164# 5 <@> print vK ->6
165# 3 <0> pushmark s ->4
82aeefe1
DM
166# 4 <$> const[SPECIAL sv_no] s* ->5 < 5.017002
167# 4 <$> const[SPECIAL sv_no] s*/FOLD ->5 >=5.017002
d51cf0c9 168EOT_EOT
36932700
NC
169# 6 <@> leave[1 ref] vKP/REFC ->(end)
170# 1 <0> enter ->2
e412117e 171# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
172# 5 <@> print vK ->6
173# 3 <0> pushmark s ->4
82aeefe1
DM
174# 4 <$> const(SPECIAL sv_no) s* ->5 < 5.017002
175# 4 <$> const(SPECIAL sv_no) s*/FOLD ->5 >=5.017002
d51cf0c9
JC
176EONT_EONT
177
178
08f3c422
FC
179my ($expect, $expect_nt) =
180 $] >= 5.019002
181 ? (" is a constant sub, optimized to a AV\n") x 2
182 : (<<'EOT_EOT', <<'EONT_EONT');
d51cf0c9
JC
183# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
184# - <@> lineseq K ->3
894ea76b 185# 1 <;> nextstate(constant 61 constant.pm:118) v:*,&,x*,x&,x$ ->2
dbeafbd1 186# 2 <0> padav[@list:FAKE:m:96] ->3
d51cf0c9
JC
187EOT_EOT
188# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
189# - <@> lineseq K ->3
894ea76b 190# 1 <;> nextstate(constant 61 constant.pm:118) v:*,&,x*,x&,x$ ->2
dbeafbd1 191# 2 <0> padav[@list:FAKE:m:71] ->3
d51cf0c9
JC
192EONT_EONT
193
e412117e
NC
194
195checkOptree ( name => 'constant sub returning list',
196 code => \&WEEKDAYS,
197 noanchors => 1,
198 expect => $expect, expect_nt => $expect_nt);
199
d51cf0c9
JC
200
201sub printem {
202 printf "myint %d mystr %s myfl %f pi %f\n"
203 , myint, mystr, myfl, pi;
204}
205
e412117e 206my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d51cf0c9
JC
207# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
208# - <@> lineseq KP ->9
be2b1c74 209# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9 210# 8 <@> prtf sK ->9
69974ce6 211# 2 <0> pushmark sM ->3
82aeefe1
DM
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
d51cf0c9
JC
222EOT_EOT
223# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
224# - <@> lineseq KP ->9
be2b1c74 225# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9 226# 8 <@> prtf sK ->9
69974ce6 227# 2 <0> pushmark sM ->3
82aeefe1
DM
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
d51cf0c9
JC
238EONT_EONT
239
69974ce6
FC
240if($] < 5.015) {
241 s/M(?=\*? ->)//g for $expect, $expect_nt;
242}
e412117e
NC
243
244checkOptree ( name => 'call many in a print statement',
245 code => \&printem,
246 strip_open_hints => 1,
247 expect => $expect, expect_nt => $expect_nt);
d51cf0c9 248
183eb698
JC
249# test constant expression folding
250
251checkOptree ( 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
d1718a7c 257# 1 <;> nextstate(main 937 (eval 53):1) v ->2
183eb698
JC
258# 4 <@> print sK ->5
259# 2 <0> pushmark s ->3
82aeefe1
DM
260# 3 <$> const[IV 6] s ->4 < 5.017002
261# 3 <$> const[IV 6] s/FOLD ->4 >=5.017002
183eb698
JC
262EOT_EOT
263# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
264# - <@> lineseq KP ->5
d1718a7c 265# 1 <;> nextstate(main 937 (eval 53):1) v ->2
183eb698
JC
266# 4 <@> print sK ->5
267# 2 <0> pushmark s ->3
82aeefe1
DM
268# 3 <$> const(IV 6) s ->4 < 5.017002
269# 3 <$> const(IV 6) s/FOLD ->4 >=5.017002
183eb698
JC
270EONT_EONT
271
272checkOptree ( 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
d1718a7c 278# 1 <;> nextstate(main 942 (eval 55):1) v ->2
183eb698
JC
279# 4 <@> print sK ->5
280# 2 <0> pushmark s ->3
82aeefe1
DM
281# 3 <$> const[PV "foobar"] s ->4 < 5.017002
282# 3 <$> const[PV "foobar"] s/FOLD ->4 >=5.017002
183eb698
JC
283EOT_EOT
284# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
285# - <@> lineseq KP ->5
d1718a7c 286# 1 <;> nextstate(main 942 (eval 55):1) v ->2
183eb698
JC
287# 4 <@> print sK ->5
288# 2 <0> pushmark s ->3
82aeefe1
DM
289# 3 <$> const(PV "foobar") s ->4 < 5.017002
290# 3 <$> const(PV "foobar") s/FOLD ->4 >=5.017002
183eb698
JC
291EONT_EONT
292
293checkOptree ( 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
d1718a7c 299# 1 <;> nextstate(main 942 (eval 55):1) v ->2
183eb698
JC
300# 4 <@> print sK ->5
301# 2 <0> pushmark s ->3
302# 3 <$> const[PV "foobar"] s ->4
303EOT_EOT
304# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
305# - <@> lineseq KP ->5
d1718a7c 306# 1 <;> nextstate(main 942 (eval 55):1) v ->2
183eb698
JC
307# 4 <@> print sK ->5
308# 2 <0> pushmark s ->3
309# 3 <$> const(PV "foobar") s ->4
310EONT_EONT
311
312checkOptree ( 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
b6093575 326# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
183eb698 327# 4 <2> sassign vKS/2 ->5
82aeefe1
DM
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
183eb698
JC
330# - <1> ex-rv2sv sKRM*/1 ->4
331# 3 <#> gvsv[*s] s ->4
b6093575 332# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
183eb698
JC
333# 8 <@> print vK ->9
334# 6 <0> pushmark s ->7
335# 7 <$> const[PV "a-lt-b"] s ->8
b6093575 336# 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
183eb698
JC
337# c <@> print vK ->d
338# a <0> pushmark s ->b
339# b <$> const[PV "b-gt-a"] s ->c
b6093575 340# d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
183eb698
JC
341# g <@> print vK ->h
342# e <0> pushmark s ->f
343# f <$> const[PV "a-le-b"] s ->g
b6093575 344# h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
183eb698
JC
345# k <@> print vK ->l
346# i <0> pushmark s ->j
347# j <$> const[PV "b-ge-a"] s ->k
b6093575 348# l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
183eb698
JC
349# o <@> print vK ->p
350# m <0> pushmark s ->n
351# n <$> const[PV "b-cmp-a"] s ->o
b6093575 352# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
82aeefe1 353# q <$> const[PVNV 0] s/SHORT ->r < 5.017002
82b84d04
FC
354# q <$> const[PVNV 0] s/FOLD,SHORT ->r >=5.017002 < 5.019001
355# q <$> const[SPECIAL sv_no] s/FOLD,SHORT ->r >=5.019001
183eb698
JC
356EOT_EOT
357# r <1> leavesub[1 ref] K/REFC,1 ->(end)
358# - <@> lineseq KP ->r
b6093575 359# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
183eb698 360# 4 <2> sassign vKS/2 ->5
82aeefe1
DM
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
183eb698
JC
363# - <1> ex-rv2sv sKRM*/1 ->4
364# 3 <$> gvsv(*s) s ->4
b6093575 365# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
183eb698
JC
366# 8 <@> print vK ->9
367# 6 <0> pushmark s ->7
368# 7 <$> const(PV "a-lt-b") s ->8
b6093575 369# 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
183eb698
JC
370# c <@> print vK ->d
371# a <0> pushmark s ->b
372# b <$> const(PV "b-gt-a") s ->c
b6093575 373# d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
183eb698
JC
374# g <@> print vK ->h
375# e <0> pushmark s ->f
376# f <$> const(PV "a-le-b") s ->g
b6093575 377# h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
183eb698
JC
378# k <@> print vK ->l
379# i <0> pushmark s ->j
380# j <$> const(PV "b-ge-a") s ->k
b6093575 381# l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
183eb698
JC
382# o <@> print vK ->p
383# m <0> pushmark s ->n
384# n <$> const(PV "b-cmp-a") s ->o
b6093575 385# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
82aeefe1
DM
386# q <$> const(SPECIAL sv_no) s/SHORT ->r < 5.017002
387# q <$> const(SPECIAL sv_no) s/FOLD,SHORT ->r >=5.017002
183eb698
JC
388EONT_EONT
389
390checkOptree ( 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
d1718a7c 396# 1 <;> nextstate(main 977 (eval 28):1) v ->2
183eb698
JC
397# 4 <@> print sK ->5
398# 2 <0> pushmark s ->3
82aeefe1
DM
399# 3 <$> const[PV "foobar5"] s ->4 < 5.017002
400# 3 <$> const[PV "foobar5"] s/FOLD ->4 >=5.017002
183eb698
JC
401EOT_EOT
402# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
403# - <@> lineseq KP ->5
d1718a7c 404# 1 <;> nextstate(main 977 (eval 28):1) v ->2
183eb698
JC
405# 4 <@> print sK ->5
406# 2 <0> pushmark s ->3
82aeefe1
DM
407# 3 <$> const(PV "foobar5") s ->4 < 5.017002
408# 3 <$> const(PV "foobar5") s/FOLD ->4 >=5.017002
183eb698
JC
409EONT_EONT
410
d51cf0c9
JC
411__END__
412
413=head NB
414
415Optimized constant subs are stored as bare scalars in the stash
416(package hash), which formerly held only GVs (typeglobs).
417
418But you cant create them manually - you cant assign a scalar to a
419stash element, and expect it to work like a constant-sub, even if you
420provide a prototype.
421
422This is a feature; alternative is too much action-at-a-distance. The
423following test demonstrates - napier is not seen as a function at all,
424much less an optimized one.
425
426=cut
427
428checkOptree ( name => 'not evertnapier',
429 code => \&napier,
430 noanchors => 1,
431 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
432 has no START
433EOT_EOT
434 has no START
435EONT_EONT
436
437