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