xref: /openbsd-src/gnu/usr.bin/perl/ext/B/t/optree_constants.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
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 => 67;
20
21#################################
22
23use 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
36sub myyes() { 1==1 }
37sub myno () { return 1!=1 }
38sub pi () { 3.14159 };
39
40my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
41
42my $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
63use constant WEEKDAYS
64    => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
65
66
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#################################
78pass("RENDER CONSTANT SUBS RETURNING SCALARS");
79
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]
87EOT_EOT
88 is a constant sub, optimized to a $want->{$func}[0]
89EONT_EONT
90
91}
92
93pass("RENDER CALLS TO THOSE CONSTANT SUBS");
94
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);
1023  <1> leavesub[2 refs] K/REFC,1 ->(end)
103-     <\@> lineseq KP ->3
1041        <;> dbstate(main 833 (eval 44):1) v ->2
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
107EOT_EOT
1083  <1> leavesub[2 refs] K/REFC,1 ->(end)
109-     <\@> lineseq KP ->3
1101        <;> dbstate(main 833 (eval 44):1) v ->2
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
113EONT_EONT
114
115}
116
117##############
118pass("MORE TESTS");
119
120checkOptree ( 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
125EOT_EOT
126 is a constant sub, optimized to a SPECIAL
127EONT_EONT
128
129
130checkOptree ( 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
142EOT_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
150EONT_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.
156checkOptree ( 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
168EOT_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
176EONT_EONT
177
178
179my ($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
187EOT_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
192EONT_EONT
193
194
195checkOptree ( name	=> 'constant sub returning list',
196	      code	=> \&WEEKDAYS,
197	      noanchors => 1,
198	      expect => $expect, expect_nt => $expect_nt);
199
200
201sub printem {
202    printf "myint %d mystr %s myfl %f pi %f\n"
203	, myint, mystr, myfl, pi;
204}
205
206my ($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
221EOT_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
236EONT_EONT
237
238if($] < 5.015) {
239    s/M(?=\*? ->)//g for $expect, $expect_nt;
240}
241if($] < 5.017002 || $] >= 5.019004) {
242    s|\\n"[])] sM\K/FOLD|| for $expect, $expect_nt;
243}
244
245checkOptree ( 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
252checkOptree ( 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
263EOT_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
271EONT_EONT
272
273checkOptree ( 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
284EOT_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
292EONT_EONT
293
294checkOptree ( 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
305EOT_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
313EONT_EONT
314
315checkOptree ( 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
364EOT_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
401EONT_EONT
402
403checkOptree ( 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
414EOT_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
422EONT_EONT
423
424__END__
425
426=head NB
427
428Optimized constant subs are stored as bare scalars in the stash
429(package hash), which formerly held only GVs (typeglobs).
430
431But you cant create them manually - you cant assign a scalar to a
432stash element, and expect it to work like a constant-sub, even if you
433provide a prototype.
434
435This is a feature; alternative is too much action-at-a-distance.  The
436following test demonstrates - napier is not seen as a function at all,
437much less an optimized one.
438
439=cut
440
441checkOptree ( name	=> 'not evertnapier',
442	      code	=> \&napier,
443	      noanchors => 1,
444	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
445 has no START
446EOT_EOT
447 has no START
448EONT_EONT
449
450
451