This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate SVt_RV, and use SVt_IV to store plain references.
[perl5.git] / ext / B / t / optree_constants.t
CommitLineData
d51cf0c9
JC
1#!perl
2
3BEGIN {
4 if ($ENV{PERL_CORE}) {
5 chdir('t') if -d 't';
6 @INC = ('.', '../lib', '../ext/B/t');
7 } else {
8 unshift @INC, 't';
9 push @INC, "../../t";
10 }
11 require Config;
12 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
13 print "1..0 # Skip -- Perl configured without B module\n";
14 exit 0;
15 }
16 # require 'test.pl'; # now done by OptreeCheck
17}
18
19use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
20use Config;
21
f9f861ec 22my $tests = 30;
d51cf0c9
JC
23plan tests => $tests;
24SKIP: {
25skip "no perlio in this build", $tests unless $Config::Config{useperlio};
26
27#################################
28
29use constant { # see also t/op/gv.t line 282
f9f861ec
JC
30 myaref => [ 1,2,3 ],
31 myfl => 1.414213,
32 myglob => \*STDIN,
33 myhref => { a => 1 },
34 myint => 42,
35 myrex => qr/foo/,
36 mystr => 'hithere',
37 mysub => \&ok,
38 myundef => undef,
39 myunsub => \&nosuch,
40};
41
42sub myyes() { 1==1 }
43sub myno () { return 1!=1 }
44sub pi () { 3.14159 };
45
4df7f6af
NC
46my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
47
f9f861ec 48my $want = { # expected types, how value renders in-line, todos (maybe)
f9f861ec 49 mystr => [ 'PV', '"'.mystr.'"' ],
4df7f6af 50 myhref => [ $RV_class, '\\\\HASH'],
f9f861ec 51 pi => [ 'NV', pi ],
4df7f6af
NC
52 myglob => [ $RV_class, '\\\\' ],
53 mysub => [ $RV_class, '\\\\' ],
54 myunsub => [ $RV_class, '\\\\' ],
f9f861ec 55 # these are not inlined, at least not per BC::Concise
4df7f6af
NC
56 #myyes => [ $RV_class, ],
57 #myno => [ $RV_class, ],
e412117e 58 $] > 5.009 ? (
4df7f6af 59 myaref => [ $RV_class, '\\\\' ],
e412117e
NC
60 myfl => [ 'NV', myfl ],
61 myint => [ 'IV', myint ],
4df7f6af 62 myrex => [ $RV_class, '\\\\' ],
e412117e
NC
63 myundef => [ 'NULL', ],
64 ) : (
65 myaref => [ 'PVIV', '' ],
66 myfl => [ 'PVNV', myfl ],
67 myint => [ 'PVIV', myint ],
68 myrex => [ 'PVNV', '' ],
69 myundef => [ 'PVIV', ],
70 )
d51cf0c9
JC
71};
72
73use constant WEEKDAYS
74 => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
75
76
d51cf0c9
JC
77$::{napier} = \2.71828; # counter-example (doesn't get optimized).
78eval "sub napier ();";
79
80
81# should be able to undefine constant::import here ???
82INIT {
83 # eval 'sub constant::import () {}';
84 # undef *constant::import::{CODE};
85};
86
87#################################
f9f861ec 88pass("RENDER CONSTANT SUBS RETURNING SCALARS");
2018a5c3 89
f9f861ec
JC
90for $func (sort keys %$want) {
91 # no strict 'refs'; # why not needed ?
92 checkOptree ( name => "$func() as a coderef",
93 code => \&{$func},
94 noanchors => 1,
95 expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
96 is a constant sub, optimized to a $want->{$func}[0]
2018a5c3 97EOT_EOT
f9f861ec 98 is a constant sub, optimized to a $want->{$func}[0]
d51cf0c9
JC
99EONT_EONT
100
f9f861ec 101}
d51cf0c9 102
f9f861ec 103pass("RENDER CALLS TO THOSE CONSTANT SUBS");
d51cf0c9 104
f9f861ec
JC
105for $func (sort keys %$want) {
106 # print "# doing $func\n";
107 checkOptree ( name => "call $func",
108 code => "$func",
109 ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
110 bc_opts => '-nobanner',
111 expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
d51cf0c9 1123 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 113- <\@> lineseq KP ->3
be2b1c74 1141 <;> dbstate(main 833 (eval 44):1) v ->2
f9f861ec 1152 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
d51cf0c9
JC
116EOT_EOT
1173 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 118- <\@> lineseq KP ->3
be2b1c74 1191 <;> dbstate(main 833 (eval 44):1) v ->2
f9f861ec 1202 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
d51cf0c9
JC
121EONT_EONT
122
f9f861ec 123}
d51cf0c9 124
f9f861ec
JC
125##############
126pass("MORE TESTS");
d51cf0c9 127
f9f861ec
JC
128checkOptree ( name => 'myyes() as coderef',
129 code => sub () { 1==1 },
2018a5c3
JC
130 noanchors => 1,
131 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec 132 is a constant sub, optimized to a SPECIAL
2018a5c3 133EOT_EOT
f9f861ec 134 is a constant sub, optimized to a SPECIAL
2018a5c3
JC
135EONT_EONT
136
137
f9f861ec 138checkOptree ( name => 'myyes() as coderef',
36932700 139 prog => 'sub a() { 1==1 }; print a',
2018a5c3 140 noanchors => 1,
e412117e 141 strip_open_hints => 1,
2018a5c3 142 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
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
148# 4 <$> const[SPECIAL sv_yes] s ->5
2018a5c3 149EOT_EOT
36932700
NC
150# 6 <@> leave[1 ref] vKP/REFC ->(end)
151# 1 <0> enter ->2
e412117e 152# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
153# 5 <@> print vK ->6
154# 3 <0> pushmark s ->4
155# 4 <$> const(SPECIAL sv_yes) s ->5
2018a5c3
JC
156EONT_EONT
157
d51cf0c9 158
36932700
NC
159# Need to do this as a prog, not code, as only the first constant to use
160# PL_sv_no actually gets to use the real thing - every one following is
161# copied.
f9f861ec 162checkOptree ( name => 'myno() as coderef',
36932700 163 prog => 'sub a() { 1!=1 }; print a',
d51cf0c9 164 noanchors => 1,
e412117e 165 strip_open_hints => 1,
d51cf0c9 166 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36932700
NC
167# 6 <@> leave[1 ref] vKP/REFC ->(end)
168# 1 <0> enter ->2
e412117e 169# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
170# 5 <@> print vK ->6
171# 3 <0> pushmark s ->4
172# 4 <$> const[SPECIAL sv_no] s ->5
d51cf0c9 173EOT_EOT
36932700
NC
174# 6 <@> leave[1 ref] vKP/REFC ->(end)
175# 1 <0> enter ->2
e412117e 176# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
177# 5 <@> print vK ->6
178# 3 <0> pushmark s ->4
179# 4 <$> const(SPECIAL sv_no) s ->5
d51cf0c9
JC
180EONT_EONT
181
182
e412117e 183my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d51cf0c9
JC
184# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
185# - <@> lineseq K ->3
dbeafbd1
NC
186# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
187# 2 <0> padav[@list:FAKE:m:96] ->3
d51cf0c9
JC
188EOT_EOT
189# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
190# - <@> lineseq K ->3
dbeafbd1
NC
191# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
192# 2 <0> padav[@list:FAKE:m:71] ->3
d51cf0c9
JC
193EONT_EONT
194
e412117e
NC
195if($] < 5.009) {
196 # 5.8.x doesn't add the m flag to padav
197 s/FAKE:m:\d+/FAKE/ foreach ($expect, $expect_nt);
198}
199
200checkOptree ( name => 'constant sub returning list',
201 code => \&WEEKDAYS,
202 noanchors => 1,
203 expect => $expect, expect_nt => $expect_nt);
204
d51cf0c9
JC
205
206sub printem {
207 printf "myint %d mystr %s myfl %f pi %f\n"
208 , myint, mystr, myfl, pi;
209}
210
e412117e 211my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d51cf0c9
JC
212# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
213# - <@> lineseq KP ->9
be2b1c74 214# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9
JC
215# 8 <@> prtf sK ->9
216# 2 <0> pushmark s ->3
217# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
218# 4 <$> const[IV 42] s ->5
219# 5 <$> const[PV "hithere"] s ->6
f9f861ec 220# 6 <$> const[NV 1.414213] s ->7
d51cf0c9
JC
221# 7 <$> const[NV 3.14159] s ->8
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
JC
226# 8 <@> prtf sK ->9
227# 2 <0> pushmark s ->3
228# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
229# 4 <$> const(IV 42) s ->5
230# 5 <$> const(PV "hithere") s ->6
f9f861ec 231# 6 <$> const(NV 1.414213) s ->7
d51cf0c9
JC
232# 7 <$> const(NV 3.14159) s ->8
233EONT_EONT
234
e412117e
NC
235if($] < 5.009) {
236 # 5.8.x's use constant has larger types
237 foreach ($expect, $expect_nt) {
238 s/IV 42/PV$&/;
239 s/NV 1.41/PV$&/;
240 }
241}
242
243checkOptree ( name => 'call many in a print statement',
244 code => \&printem,
245 strip_open_hints => 1,
246 expect => $expect, expect_nt => $expect_nt);
d51cf0c9
JC
247
248} #skip
249
250__END__
251
252=head NB
253
254Optimized constant subs are stored as bare scalars in the stash
255(package hash), which formerly held only GVs (typeglobs).
256
257But you cant create them manually - you cant assign a scalar to a
258stash element, and expect it to work like a constant-sub, even if you
259provide a prototype.
260
261This is a feature; alternative is too much action-at-a-distance. The
262following test demonstrates - napier is not seen as a function at all,
263much less an optimized one.
264
265=cut
266
267checkOptree ( name => 'not evertnapier',
268 code => \&napier,
269 noanchors => 1,
270 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
271 has no START
272EOT_EOT
273 has no START
274EONT_EONT
275
276