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