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
1 #!perl
2
3 BEGIN {
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
19 use OptreeCheck;        # ALSO DOES @ARGV HANDLING !!!!!!
20 use Config;
21
22 my $tests = 30;
23 plan tests => $tests;
24 SKIP: {
25 skip "no perlio in this build", $tests unless $Config::Config{useperlio};
26
27 #################################
28
29 use constant {          # see also t/op/gv.t line 282
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
42 sub myyes() { 1==1 }
43 sub myno () { return 1!=1 }
44 sub pi () { 3.14159 };
45
46 my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
47
48 my $want = {    # expected types, how value renders in-line, todos (maybe)
49     mystr       => [ 'PV', '"'.mystr.'"' ],
50     myhref      => [ $RV_class, '\\\\HASH'],
51     pi          => [ 'NV', pi ],
52     myglob      => [ $RV_class, '\\\\' ],
53     mysub       => [ $RV_class, '\\\\' ],
54     myunsub     => [ $RV_class, '\\\\' ],
55     # these are not inlined, at least not per BC::Concise
56     #myyes      => [ $RV_class, ],
57     #myno       => [ $RV_class, ],
58     $] > 5.009 ? (
59     myaref      => [ $RV_class, '\\\\' ],
60     myfl        => [ 'NV', myfl ],
61     myint       => [ 'IV', myint ],
62     myrex       => [ $RV_class, '\\\\' ],
63     myundef     => [ 'NULL', ],
64     ) : (
65     myaref      => [ 'PVIV', '' ],
66     myfl        => [ 'PVNV', myfl ],
67     myint       => [ 'PVIV', myint ],
68     myrex       => [ 'PVNV', '' ],
69     myundef     => [ 'PVIV', ],
70     )
71 };
72
73 use constant WEEKDAYS
74     => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
75
76
77 $::{napier} = \2.71828; # counter-example (doesn't get optimized).
78 eval "sub napier ();";
79
80
81 # should be able to undefine constant::import here ???
82 INIT { 
83     # eval 'sub constant::import () {}';
84     # undef *constant::import::{CODE};
85 };
86
87 #################################
88 pass("RENDER CONSTANT SUBS RETURNING SCALARS");
89
90 for $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]
97 EOT_EOT
98  is a constant sub, optimized to a $want->{$func}[0]
99 EONT_EONT
100
101 }
102
103 pass("RENDER CALLS TO THOSE CONSTANT SUBS");
104
105 for $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);
112 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
113 -     <\@> lineseq KP ->3
114 1        <;> dbstate(main 833 (eval 44):1) v ->2
115 2        <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
116 EOT_EOT
117 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
118 -     <\@> lineseq KP ->3
119 1        <;> dbstate(main 833 (eval 44):1) v ->2
120 2        <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
121 EONT_EONT
122
123 }
124
125 ##############
126 pass("MORE TESTS");
127
128 checkOptree ( name      => 'myyes() as coderef',
129               code      => sub () { 1==1 },
130               noanchors => 1,
131               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
132  is a constant sub, optimized to a SPECIAL
133 EOT_EOT
134  is a constant sub, optimized to a SPECIAL
135 EONT_EONT
136
137
138 checkOptree ( name      => 'myyes() as coderef',
139               prog      => 'sub a() { 1==1 }; print a',
140               noanchors => 1,
141               strip_open_hints => 1,
142               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
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
149 EOT_EOT
150 # 6  <@> leave[1 ref] vKP/REFC ->(end)
151 # 1     <0> enter ->2
152 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
153 # 5     <@> print vK ->6
154 # 3        <0> pushmark s ->4
155 # 4        <$> const(SPECIAL sv_yes) s ->5
156 EONT_EONT
157
158
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.
162 checkOptree ( name      => 'myno() as coderef',
163               prog      => 'sub a() { 1!=1 }; print a',
164               noanchors => 1,
165               strip_open_hints => 1,
166               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
167 # 6  <@> leave[1 ref] vKP/REFC ->(end)
168 # 1     <0> enter ->2
169 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
170 # 5     <@> print vK ->6
171 # 3        <0> pushmark s ->4
172 # 4        <$> const[SPECIAL sv_no] s ->5
173 EOT_EOT
174 # 6  <@> leave[1 ref] vKP/REFC ->(end)
175 # 1     <0> enter ->2
176 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
177 # 5     <@> print vK ->6
178 # 3        <0> pushmark s ->4
179 # 4        <$> const(SPECIAL sv_no) s ->5
180 EONT_EONT
181
182
183 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
184 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
185 # -     <@> lineseq K ->3
186 # 1        <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
187 # 2        <0> padav[@list:FAKE:m:96] ->3
188 EOT_EOT
189 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
190 # -     <@> lineseq K ->3
191 # 1        <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
192 # 2        <0> padav[@list:FAKE:m:71] ->3
193 EONT_EONT
194
195 if($] < 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
200 checkOptree ( name      => 'constant sub returning list',
201               code      => \&WEEKDAYS,
202               noanchors => 1,
203               expect => $expect, expect_nt => $expect_nt);
204
205
206 sub printem {
207     printf "myint %d mystr %s myfl %f pi %f\n"
208         , myint, mystr, myfl, pi;
209 }
210
211 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
212 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
213 # -     <@> lineseq KP ->9
214 # 1        <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
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
220 # 6           <$> const[NV 1.414213] s ->7
221 # 7           <$> const[NV 3.14159] s ->8
222 EOT_EOT
223 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
224 # -     <@> lineseq KP ->9
225 # 1        <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
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
231 # 6           <$> const(NV 1.414213) s ->7
232 # 7           <$> const(NV 3.14159) s ->8
233 EONT_EONT
234
235 if($] < 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
243 checkOptree ( name      => 'call many in a print statement',
244               code      => \&printem,
245               strip_open_hints => 1,
246               expect => $expect, expect_nt => $expect_nt);
247
248 } #skip
249
250 __END__
251
252 =head NB
253
254 Optimized constant subs are stored as bare scalars in the stash
255 (package hash), which formerly held only GVs (typeglobs).
256
257 But you cant create them manually - you cant assign a scalar to a
258 stash element, and expect it to work like a constant-sub, even if you
259 provide a prototype.
260
261 This is a feature; alternative is too much action-at-a-distance.  The
262 following test demonstrates - napier is not seen as a function at all,
263 much less an optimized one.
264
265 =cut
266
267 checkOptree ( name      => 'not evertnapier',
268               code      => \&napier,
269               noanchors => 1,
270               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
271  has no START
272 EOT_EOT
273  has no START
274 EONT_EONT
275
276