6 @INC = ('.', '../lib', '../ext/B/t');
12 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
13 print "1..0 # Skip -- Perl configured without B module\n";
16 # require 'test.pl'; # now done by OptreeCheck
19 use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
25 skip "no perlio in this build", $tests unless $Config::Config{useperlio};
27 #################################
29 use constant { # see also t/op/gv.t line 282
43 sub myno () { return 1!=1 }
44 sub pi () { 3.14159 };
46 my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
48 my $want = { # expected types, how value renders in-line, todos (maybe)
49 mystr => [ 'PV', '"'.mystr.'"' ],
50 myhref => [ $RV_class, '\\\\HASH'],
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, ],
59 myaref => [ $RV_class, '\\\\' ],
60 myfl => [ 'NV', myfl ],
61 myint => [ 'IV', myint ],
62 myrex => [ $RV_class, '\\\\' ],
63 myundef => [ 'NULL', ],
65 myaref => [ 'PVIV', '' ],
66 myfl => [ 'PVNV', myfl ],
67 myint => [ 'PVIV', myint ],
68 myrex => [ 'PVNV', '' ],
69 myundef => [ 'PVIV', ],
74 => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
77 $::{napier} = \2.71828; # counter-example (doesn't get optimized).
78 eval "sub napier ();";
81 # should be able to undefine constant::import here ???
83 # eval 'sub constant::import () {}';
84 # undef *constant::import::{CODE};
87 #################################
88 pass("RENDER CONSTANT SUBS RETURNING SCALARS");
90 for $func (sort keys %$want) {
91 # no strict 'refs'; # why not needed ?
92 checkOptree ( name => "$func() as a coderef",
95 expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
96 is a constant sub, optimized to a $want->{$func}[0]
98 is a constant sub, optimized to a $want->{$func}[0]
103 pass("RENDER CALLS TO THOSE CONSTANT SUBS");
105 for $func (sort keys %$want) {
106 # print "# doing $func\n";
107 checkOptree ( name => "call $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
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
128 checkOptree ( name => 'myyes() as coderef',
129 code => sub () { 1==1 },
131 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
132 is a constant sub, optimized to a SPECIAL
134 is a constant sub, optimized to a SPECIAL
138 checkOptree ( name => 'myyes() as coderef',
139 prog => 'sub a() { 1==1 }; print a',
141 strip_open_hints => 1,
142 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
143 # 6 <@> leave[1 ref] vKP/REFC ->(end)
145 # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
147 # 3 <0> pushmark s ->4
148 # 4 <$> const[SPECIAL sv_yes] s ->5
150 # 6 <@> leave[1 ref] vKP/REFC ->(end)
152 # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
154 # 3 <0> pushmark s ->4
155 # 4 <$> const(SPECIAL sv_yes) s ->5
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
162 checkOptree ( name => 'myno() as coderef',
163 prog => 'sub a() { 1!=1 }; print a',
165 strip_open_hints => 1,
166 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
167 # 6 <@> leave[1 ref] vKP/REFC ->(end)
169 # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
171 # 3 <0> pushmark s ->4
172 # 4 <$> const[SPECIAL sv_no] s ->5
174 # 6 <@> leave[1 ref] vKP/REFC ->(end)
176 # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
178 # 3 <0> pushmark s ->4
179 # 4 <$> const(SPECIAL sv_no) s ->5
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
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
196 # 5.8.x doesn't add the m flag to padav
197 s/FAKE:m:\d+/FAKE/ foreach ($expect, $expect_nt);
200 checkOptree ( name => 'constant sub returning list',
203 expect => $expect, expect_nt => $expect_nt);
207 printf "myint %d mystr %s myfl %f pi %f\n"
208 , myint, mystr, myfl, pi;
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
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
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
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
236 # 5.8.x's use constant has larger types
237 foreach ($expect, $expect_nt) {
243 checkOptree ( name => 'call many in a print statement',
245 strip_open_hints => 1,
246 expect => $expect, expect_nt => $expect_nt);
254 Optimized constant subs are stored as bare scalars in the stash
255 (package hash), which formerly held only GVs (typeglobs).
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
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.
267 checkOptree ( name => 'not evertnapier',
270 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');