This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
49243f59cf953c8f1553dc14e70f3026a02eda62
[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 = 23;
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     myint => 42,
31     mystr => 'hithere',
32     myfl => 3.14159,
33     myrex => qr/foo/,
34     myglob => \*STDIN,
35     myaref => [ 1,2,3 ],
36     myhref => { a => 1 },
37     myundef => undef,
38     mysub => \&ok,
39     mysub => \&nosuch,
40 };
41
42 use constant WEEKDAYS
43     => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
44
45
46 sub pi () { 3.14159 };
47 $::{napier} = \2.71828; # counter-example (doesn't get optimized).
48 eval "sub napier ();";
49
50
51 # should be able to undefine constant::import here ???
52 INIT { 
53     # eval 'sub constant::import () {}';
54     # undef *constant::import::{CODE};
55 };
56
57 #################################
58 pass("CONSTANT SUBS RETURNING SCALARS");
59
60 checkOptree ( name      => 'myint() as coderef',
61               code      => \&myint,
62               noanchors => 1,
63               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
64  is a constant sub, optimized to a IV
65 EOT_EOT
66  is a constant sub, optimized to a IV
67 EONT_EONT
68
69
70 checkOptree ( name      => 'mystr() as coderef',
71               code      => \&mystr,
72               noanchors => 1,
73               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
74  is a constant sub, optimized to a PV
75 EOT_EOT
76  is a constant sub, optimized to a PV
77 EONT_EONT
78
79
80 checkOptree ( name      => 'myfl() as coderef',
81               code      => \&myfl,
82               noanchors => 1,
83               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
84  is a constant sub, optimized to a NV
85 EOT_EOT
86  is a constant sub, optimized to a NV
87 EONT_EONT
88
89
90 checkOptree ( name      => 'myrex() as coderef',
91               code      => \&myrex,
92               noanchors => 1,
93               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
94  is a constant sub, optimized to a RV
95 EOT_EOT
96  is a constant sub, optimized to a RV
97 EONT_EONT
98
99
100 checkOptree ( name      => 'myglob() as coderef',
101               code      => \&myglob,
102               noanchors => 1,
103               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
104  is a constant sub, optimized to a RV
105 EOT_EOT
106  is a constant sub, optimized to a RV
107 EONT_EONT
108
109
110 checkOptree ( name      => 'myaref() as coderef',
111               code      => \&myaref,
112               noanchors => 1,
113               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
114  is a constant sub, optimized to a RV
115 EOT_EOT
116  is a constant sub, optimized to a RV
117 EONT_EONT
118
119
120 checkOptree ( name      => 'myhref() as coderef',
121               code      => \&myhref,
122               noanchors => 1,
123               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
124  is a constant sub, optimized to a RV
125 EOT_EOT
126  is a constant sub, optimized to a RV
127 EONT_EONT
128
129
130 checkOptree ( name      => 'myundef() as coderef',
131               code      => \&myundef,
132               noanchors => 1,
133               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
134  is a constant sub, optimized to a NULL
135 EOT_EOT
136  is a constant sub, optimized to a NULL
137 EONT_EONT
138
139
140 checkOptree ( name      => 'mysub() as coderef',
141               code      => \&mysub,
142               noanchors => 1,
143               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
144  is a constant sub, optimized to a RV
145 EOT_EOT
146  is a constant sub, optimized to a RV
147 EONT_EONT
148
149
150 checkOptree ( name      => 'myunsub() as coderef',
151               todo      => '- may prove only that sub is unformed',
152               code      => \&myunsub,
153               noanchors => 1,
154               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
155  has no START
156 EOT_EOT
157  has no START
158 EONT_EONT
159
160
161 ##############
162
163 checkOptree ( name      => 'call myint',
164               code      => 'myint',
165               bc_opts   => '-nobanner',
166               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
167 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
168 -     <@> lineseq KP ->3
169 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
170 2        <$> const[IV 42] s ->3
171 EOT_EOT
172 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
173 -     <@> lineseq KP ->3
174 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
175 2        <$> const(IV 42) s ->3
176 EONT_EONT
177
178
179 checkOptree ( name      => 'call mystr',
180               code      => 'mystr',
181               bc_opts   => '-nobanner',
182               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
183 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
184 -     <@> lineseq KP ->3
185 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
186 2        <$> const[PV "hithere"] s ->3
187 EOT_EOT
188 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
189 -     <@> lineseq KP ->3
190 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
191 2        <$> const(PV "hithere") s ->3
192 EONT_EONT
193
194
195 checkOptree ( name      => 'call myfl',
196               code      => 'myfl',
197               bc_opts   => '-nobanner',
198               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
199 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
200 -     <@> lineseq KP ->3
201 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
202 2        <$> const[NV 3.14159] s ->3
203 EOT_EOT
204 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
205 -     <@> lineseq KP ->3
206 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
207 2        <$> const(NV 3.14159) s ->3
208 EONT_EONT
209
210
211 checkOptree ( name      => 'call myrex',
212               code      => 'myrex',
213               todo      => '- RV value is bare backslash',
214               noanchors => 1,
215               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
216 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
217 # -     <@> lineseq KP ->3
218 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
219 # 2        <$> const[RV \\] s ->3
220 EOT_EOT
221 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
222 # -     <@> lineseq KP ->3
223 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
224 # 2        <$> const(RV \\) s ->3
225 EONT_EONT
226
227
228 checkOptree ( name      => 'call myglob',
229               code      => 'myglob',
230               todo      => '- RV value is bare backslash',
231               noanchors => 1,
232               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
233 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
234 # -     <@> lineseq KP ->3
235 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
236 # 2        <$> const[RV \\] s ->3
237 EOT_EOT
238 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
239 # -     <@> lineseq KP ->3
240 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
241 # 2        <$> const(RV \\) s ->3
242 EONT_EONT
243
244
245 checkOptree ( name      => 'call myaref',
246               code      => 'myaref',
247               todo      => '- RV value is bare backslash',
248               noanchors => 1,
249               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
250 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
251 # -     <@> lineseq KP ->3
252 # 1        <;> nextstate(main 758 (eval 29):1) v ->2
253 # 2        <$> const[RV \\] s ->3
254 EOT_EOT
255 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
256 # -     <@> lineseq KP ->3
257 # 1        <;> nextstate(main 758 (eval 29):1) v ->2
258 # 2        <$> const(RV \\) s ->3
259 EONT_EONT
260
261
262 checkOptree ( name      => 'call myhref',
263               code      => 'myhref',
264               noanchors => 1,
265               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
266 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
267 # -     <@> lineseq KP ->3
268 # 1        <;> nextstate(main 763 (eval 31):1) v ->2
269 # 2        <$> const[RV \\HASH] s ->3
270 EOT_EOT
271 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
272 # -     <@> lineseq KP ->3
273 # 1        <;> nextstate(main 763 (eval 31):1) v ->2
274 # 2        <$> const(RV \\HASH) s ->3
275 EONT_EONT
276
277
278 checkOptree ( name      => 'call myundef',
279               code      => 'myundef',
280               noanchors => 1,
281               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
282 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
283 # -     <@> lineseq KP ->3
284 # 1        <;> nextstate(main 771 (eval 35):1) v ->2
285 # 2        <$> const[NULL ] s ->3
286 EOT_EOT
287 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
288 # -     <@> lineseq KP ->3
289 # 1        <;> nextstate(main 771 (eval 35):1) v ->2
290 # 2        <$> const(NULL ) s ->3
291 EONT_EONT
292
293
294 checkOptree ( name      => 'call mysub',
295               code      => 'mysub',
296               noanchors => 1,
297               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
298 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
299 # -     <@> lineseq KP ->3
300 # 1        <;> nextstate(main 771 (eval 35):1) v ->2
301 # 2        <$> const[RV \\] s ->3
302 EOT_EOT
303 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
304 # -     <@> lineseq KP ->3
305 # 1        <;> nextstate(main 771 (eval 35):1) v ->2
306 # 2        <$> const(RV \\) s ->3
307 EONT_EONT
308
309 ##################
310
311 # test constant sub defined w/o 'use constant'
312
313 checkOptree ( name      => "pi(), defined w/o 'use constant'",
314               code      => \&pi,
315               noanchors => 1,
316               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
317  is a constant sub, optimized to a NV
318 EOT_EOT
319  is a constant sub, optimized to a NV
320 EONT_EONT
321
322
323 checkOptree ( name      => 'constant sub returning list',
324               code      => \&WEEKDAYS,
325               noanchors => 1,
326               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
327 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
328 # -     <@> lineseq K ->3
329 # 1        <;> nextstate(constant 685 constant.pm:121) v ->2
330 # 2        <0> padav[@list:FAKE:m:102] ->3
331 EOT_EOT
332 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
333 # -     <@> lineseq K ->3
334 # 1        <;> nextstate(constant 685 constant.pm:121) v ->2
335 # 2        <0> padav[@list:FAKE:m:76] ->3
336 EONT_EONT
337
338
339 sub printem {
340     printf "myint %d mystr %s myfl %f pi %f\n"
341         , myint, mystr, myfl, pi;
342 }
343
344 checkOptree ( name      => 'call many in a print statement',
345               code      => \&printem,
346               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
347 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
348 # -     <@> lineseq KP ->9
349 # 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
350 # 8        <@> prtf sK ->9
351 # 2           <0> pushmark s ->3
352 # 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
353 # 4           <$> const[IV 42] s ->5
354 # 5           <$> const[PV "hithere"] s ->6
355 # 6           <$> const[NV 3.14159] s ->7
356 # 7           <$> const[NV 3.14159] s ->8
357 EOT_EOT
358 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
359 # -     <@> lineseq KP ->9
360 # 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
361 # 8        <@> prtf sK ->9
362 # 2           <0> pushmark s ->3
363 # 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
364 # 4           <$> const(IV 42) s ->5
365 # 5           <$> const(PV "hithere") s ->6
366 # 6           <$> const(NV 3.14159) s ->7
367 # 7           <$> const(NV 3.14159) s ->8
368 EONT_EONT
369
370
371 } #skip
372
373 __END__
374
375 =head NB
376
377 Optimized constant subs are stored as bare scalars in the stash
378 (package hash), which formerly held only GVs (typeglobs).
379
380 But you cant create them manually - you cant assign a scalar to a
381 stash element, and expect it to work like a constant-sub, even if you
382 provide a prototype.
383
384 This is a feature; alternative is too much action-at-a-distance.  The
385 following test demonstrates - napier is not seen as a function at all,
386 much less an optimized one.
387
388 =cut
389
390 checkOptree ( name      => 'not evertnapier',
391               code      => \&napier,
392               noanchors => 1,
393               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
394  has no START
395 EOT_EOT
396  has no START
397 EONT_EONT
398
399