6 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
7 print "1..0 # Skip -- Perl configured without B module\n";
10 if (!$Config::Config{useperlio}) {
11 print "1..0 # Skip -- need perlio to walk the optree\n";
16 use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
21 #################################
23 use constant { # see also t/op/gv.t line 282
37 sub myno () { return 1!=1 }
38 sub pi () { 3.14159 };
40 my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
42 my $want = { # expected types, how value renders in-line, todos (maybe)
43 mystr => [ 'PV', '"'.mystr.'"' ],
44 myhref => [ $RV_class, '\\\\HASH'],
46 myglob => [ $RV_class, '\\\\' ],
47 mysub => [ $RV_class, '\\\\' ],
48 myunsub => [ $RV_class, '\\\\' ],
49 # these are not inlined, at least not per BC::Concise
50 #myyes => [ $RV_class, ],
51 #myno => [ $RV_class, ],
53 myaref => [ $RV_class, '\\\\' ],
54 myfl => [ 'NV', myfl ],
55 myint => [ 'IV', myint ],
57 myrex => [ $RV_class, '\\\\"\\(?^:Foo\\)"' ],
59 myrex => [ $RV_class, '\\\\' ],
61 myundef => [ 'NULL', ],
63 myaref => [ 'PVIV', '' ],
64 myfl => [ 'PVNV', myfl ],
65 myint => [ 'PVIV', myint ],
66 myrex => [ 'PVNV', '' ],
67 myundef => [ 'PVIV', ],
72 => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
75 $::{napier} = \2.71828; # counter-example (doesn't get optimized).
76 eval "sub napier ();";
79 # should be able to undefine constant::import here ???
81 # eval 'sub constant::import () {}';
82 # undef *constant::import::{CODE};
85 #################################
86 pass("RENDER CONSTANT SUBS RETURNING SCALARS");
88 for $func (sort keys %$want) {
89 # no strict 'refs'; # why not needed ?
90 checkOptree ( name => "$func() as a coderef",
93 expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
94 is a constant sub, optimized to a $want->{$func}[0]
96 is a constant sub, optimized to a $want->{$func}[0]
101 pass("RENDER CALLS TO THOSE CONSTANT SUBS");
103 for $func (sort keys %$want) {
104 # print "# doing $func\n";
105 checkOptree ( name => "call $func",
107 ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
108 bc_opts => '-nobanner',
109 expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
110 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
111 - <\@> lineseq KP ->3
112 1 <;> dbstate(main 833 (eval 44):1) v:% ->2
113 2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s* ->3
115 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
116 - <\@> lineseq KP ->3
117 1 <;> dbstate(main 833 (eval 44):1) v:% ->2
118 2 <\$> const($want->{$func}[0] $want->{$func}[1]) s* ->3
126 checkOptree ( name => 'myyes() as coderef',
127 code => sub () { 1==1 },
129 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
130 is a constant sub, optimized to a SPECIAL
132 is a constant sub, optimized to a SPECIAL
136 checkOptree ( name => 'myyes() as coderef',
137 prog => 'sub a() { 1==1 }; print a',
139 strip_open_hints => 1,
140 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
141 # 6 <@> leave[1 ref] vKP/REFC ->(end)
143 # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
145 # 3 <0> pushmark s ->4
146 # 4 <$> const[SPECIAL sv_yes] s* ->5
148 # 6 <@> leave[1 ref] vKP/REFC ->(end)
150 # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
152 # 3 <0> pushmark s ->4
153 # 4 <$> const(SPECIAL sv_yes) s* ->5
157 # Need to do this as a prog, not code, as only the first constant to use
158 # PL_sv_no actually gets to use the real thing - every one following is
160 checkOptree ( name => 'myno() as coderef',
161 prog => 'sub a() { 1!=1 }; print a',
163 strip_open_hints => 1,
164 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
165 # 6 <@> leave[1 ref] vKP/REFC ->(end)
167 # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
169 # 3 <0> pushmark s ->4
170 # 4 <$> const[SPECIAL sv_no] s* ->5
172 # 6 <@> leave[1 ref] vKP/REFC ->(end)
174 # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
176 # 3 <0> pushmark s ->4
177 # 4 <$> const(SPECIAL sv_no) s* ->5
181 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
182 # 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
183 # - <@> lineseq K ->3
184 # 1 <;> nextstate(constant 61 constant.pm:118) v:%,*,& ->2
185 # 2 <0> padav[@list:FAKE:m:96] ->3
187 # 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
188 # - <@> lineseq K ->3
189 # 1 <;> nextstate(constant 61 constant.pm:118) v:%,*,& ->2
190 # 2 <0> padav[@list:FAKE:m:71] ->3
194 # 5.8.x doesn't add the m flag to padav
195 s/FAKE:m:\d+/FAKE/ foreach ($expect, $expect_nt);
198 checkOptree ( name => 'constant sub returning list',
201 expect => $expect, expect_nt => $expect_nt);
205 printf "myint %d mystr %s myfl %f pi %f\n"
206 , myint, mystr, myfl, pi;
209 my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
210 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
211 # - <@> lineseq KP ->9
212 # 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
214 # 2 <0> pushmark sM ->3
215 # 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM ->4
216 # 4 <$> const[IV 42] sM* ->5
217 # 5 <$> const[PV "hithere"] sM* ->6
218 # 6 <$> const[NV 1.414213] sM* ->7
219 # 7 <$> const[NV 3.14159] sM* ->8
221 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
222 # - <@> lineseq KP ->9
223 # 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
225 # 2 <0> pushmark sM ->3
226 # 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM ->4
227 # 4 <$> const(IV 42) sM* ->5
228 # 5 <$> const(PV "hithere") sM* ->6
229 # 6 <$> const(NV 1.414213) sM* ->7
230 # 7 <$> const(NV 3.14159) sM* ->8
234 s/M(?=\*? ->)//g for $expect, $expect_nt;
237 # 5.8.x's use constant has larger types
238 foreach ($expect, $expect_nt) {
244 checkOptree ( name => 'call many in a print statement',
246 strip_open_hints => 1,
247 expect => $expect, expect_nt => $expect_nt);
249 # test constant expression folding
251 checkOptree ( name => 'arithmetic constant folding in print',
252 code => 'print 1+2+3',
253 strip_open_hints => 1,
254 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
255 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
256 # - <@> lineseq KP ->5
257 # 1 <;> nextstate(main 937 (eval 53):1) v:% ->2
259 # 2 <0> pushmark s ->3
260 # 3 <$> const[IV 6] s ->4
262 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
263 # - <@> lineseq KP ->5
264 # 1 <;> nextstate(main 937 (eval 53):1) v:% ->2
266 # 2 <0> pushmark s ->3
267 # 3 <$> const(IV 6) s ->4
270 checkOptree ( name => 'string constant folding in print',
271 code => 'print "foo"."bar"',
272 strip_open_hints => 1,
273 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
274 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
275 # - <@> lineseq KP ->5
276 # 1 <;> nextstate(main 942 (eval 55):1) v:% ->2
278 # 2 <0> pushmark s ->3
279 # 3 <$> const[PV "foobar"] s ->4
281 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
282 # - <@> lineseq KP ->5
283 # 1 <;> nextstate(main 942 (eval 55):1) v:% ->2
285 # 2 <0> pushmark s ->3
286 # 3 <$> const(PV "foobar") s ->4
289 checkOptree ( name => 'boolean or folding',
290 code => 'print "foobar" if 1 or 0',
291 strip_open_hints => 1,
292 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
293 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
294 # - <@> lineseq KP ->5
295 # 1 <;> nextstate(main 942 (eval 55):1) v:% ->2
297 # 2 <0> pushmark s ->3
298 # 3 <$> const[PV "foobar"] s ->4
300 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
301 # - <@> lineseq KP ->5
302 # 1 <;> nextstate(main 942 (eval 55):1) v:% ->2
304 # 2 <0> pushmark s ->3
305 # 3 <$> const(PV "foobar") s ->4
308 checkOptree ( name => 'lc*,uc*,gt,lt,ge,le,cmp',
310 $s = uc('foo.').ucfirst('bar.').lc('LOW.').lcfirst('LOW');
311 print "a-lt-b" if "a" lt "b";
312 print "b-gt-a" if "b" gt "a";
313 print "a-le-b" if "a" le "b";
314 print "b-ge-a" if "b" ge "a";
315 print "b-cmp-a" if "b" cmp "a";
316 print "a-gt-b" if "a" gt "b"; # should be suppressed
318 strip_open_hints => 1,
319 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
320 # r <1> leavesub[1 ref] K/REFC,1 ->(end)
321 # - <@> lineseq KP ->r
322 # 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
323 # 4 <2> sassign vKS/2 ->5
324 # 2 <$> const[PV "FOO.Bar.low.lOW"] s ->3
325 # - <1> ex-rv2sv sKRM*/1 ->4
326 # 3 <#> gvsv[*s] s ->4
327 # 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
329 # 6 <0> pushmark s ->7
330 # 7 <$> const[PV "a-lt-b"] s ->8
331 # 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
333 # a <0> pushmark s ->b
334 # b <$> const[PV "b-gt-a"] s ->c
335 # d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
337 # e <0> pushmark s ->f
338 # f <$> const[PV "a-le-b"] s ->g
339 # h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
341 # i <0> pushmark s ->j
342 # j <$> const[PV "b-ge-a"] s ->k
343 # l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
345 # m <0> pushmark s ->n
346 # n <$> const[PV "b-cmp-a"] s ->o
347 # p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
348 # q <$> const[PVNV 0] s/SHORT ->r
350 # r <1> leavesub[1 ref] K/REFC,1 ->(end)
351 # - <@> lineseq KP ->r
352 # 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
353 # 4 <2> sassign vKS/2 ->5
354 # 2 <$> const(PV "FOO.Bar.low.lOW") s ->3
355 # - <1> ex-rv2sv sKRM*/1 ->4
356 # 3 <$> gvsv(*s) s ->4
357 # 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
359 # 6 <0> pushmark s ->7
360 # 7 <$> const(PV "a-lt-b") s ->8
361 # 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
363 # a <0> pushmark s ->b
364 # b <$> const(PV "b-gt-a") s ->c
365 # d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
367 # e <0> pushmark s ->f
368 # f <$> const(PV "a-le-b") s ->g
369 # h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
371 # i <0> pushmark s ->j
372 # j <$> const(PV "b-ge-a") s ->k
373 # l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
375 # m <0> pushmark s ->n
376 # n <$> const(PV "b-cmp-a") s ->o
377 # p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
378 # q <$> const(SPECIAL sv_no) s/SHORT ->r
381 checkOptree ( name => 'mixed constant folding, with explicit braces',
382 code => 'print "foo"."bar".(2+3)',
383 strip_open_hints => 1,
384 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
385 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
386 # - <@> lineseq KP ->5
387 # 1 <;> nextstate(main 977 (eval 28):1) v:% ->2
389 # 2 <0> pushmark s ->3
390 # 3 <$> const[PV "foobar5"] s ->4
392 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
393 # - <@> lineseq KP ->5
394 # 1 <;> nextstate(main 977 (eval 28):1) v:% ->2
396 # 2 <0> pushmark s ->3
397 # 3 <$> const(PV "foobar5") s ->4
404 Optimized constant subs are stored as bare scalars in the stash
405 (package hash), which formerly held only GVs (typeglobs).
407 But you cant create them manually - you cant assign a scalar to a
408 stash element, and expect it to work like a constant-sub, even if you
411 This is a feature; alternative is too much action-at-a-distance. The
412 following test demonstrates - napier is not seen as a function at all,
413 much less an optimized one.
417 checkOptree ( name => 'not evertnapier',
420 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');