Commit | Line | Data |
d51cf0c9 |
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 | |
2018a5c3 |
22 | my $tests = 23; |
d51cf0c9 |
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 }, |
2018a5c3 |
37 | myundef => undef, |
38 | mysub => \&ok, |
39 | mysub => \&nosuch, |
d51cf0c9 |
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, |
d51cf0c9 |
92 | noanchors => 1, |
93 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
2018a5c3 |
94 | is a constant sub, optimized to a RV |
d51cf0c9 |
95 | EOT_EOT |
2018a5c3 |
96 | is a constant sub, optimized to a RV |
d51cf0c9 |
97 | EONT_EONT |
98 | |
99 | |
100 | checkOptree ( name => 'myglob() as coderef', |
101 | code => \&myglob, |
d51cf0c9 |
102 | noanchors => 1, |
103 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
2018a5c3 |
104 | is a constant sub, optimized to a RV |
d51cf0c9 |
105 | EOT_EOT |
2018a5c3 |
106 | is a constant sub, optimized to a RV |
d51cf0c9 |
107 | EONT_EONT |
108 | |
109 | |
110 | checkOptree ( name => 'myaref() as coderef', |
111 | code => \&myaref, |
d51cf0c9 |
112 | noanchors => 1, |
113 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
2018a5c3 |
114 | is a constant sub, optimized to a RV |
d51cf0c9 |
115 | EOT_EOT |
2018a5c3 |
116 | is a constant sub, optimized to a RV |
d51cf0c9 |
117 | EONT_EONT |
118 | |
119 | |
120 | checkOptree ( name => 'myhref() as coderef', |
121 | code => \&myhref, |
d51cf0c9 |
122 | noanchors => 1, |
123 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
2018a5c3 |
124 | is a constant sub, optimized to a RV |
d51cf0c9 |
125 | EOT_EOT |
2018a5c3 |
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 |
d51cf0c9 |
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 | |
2018a5c3 |
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 | |
d51cf0c9 |
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 | |
2018a5c3 |
323 | checkOptree ( name => 'constant sub returning list', |
d51cf0c9 |
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 | |
2018a5c3 |
344 | checkOptree ( name => 'call many in a print statement', |
d51cf0c9 |
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 | |