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};
29 if (((caller 0)[10]||{})->{open}) {
30 @open_todo = (skip => "\$^OPEN is set");
35 #################################
37 use constant { # see also t/op/gv.t line 282
51 sub myno () { return 1!=1 }
52 sub pi () { 3.14159 };
54 my $want = { # expected types, how value renders in-line, todos (maybe)
55 myfl => [ 'NV', myfl ],
56 myint => [ 'IV', myint ],
57 mystr => [ 'PV', '"'.mystr.'"' ],
58 myhref => [ 'RV', '\\\\HASH'],
59 myundef => [ 'NULL', ],
61 # these have todos, since they render as a bare backslash
62 myaref => [ 'RV', '\\\\', ' - should render as \\ARRAY' ],
63 myglob => [ 'RV', '\\\\', ' - should render as \\GV' ],
64 myrex => [ 'RV', '\\\\', ' - should render as ??' ],
65 mysub => [ 'RV', '\\\\', ' - should render as \\CV' ],
66 myunsub => [ 'RV', '\\\\', ' - should render as \\CV' ],
67 # these are not inlined, at least not per BC::Concise
73 => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
76 $::{napier} = \2.71828; # counter-example (doesn't get optimized).
77 eval "sub napier ();";
80 # should be able to undefine constant::import here ???
82 # eval 'sub constant::import () {}';
83 # undef *constant::import::{CODE};
86 #################################
87 pass("RENDER CONSTANT SUBS RETURNING SCALARS");
89 for $func (sort keys %$want) {
90 # no strict 'refs'; # why not needed ?
91 checkOptree ( name => "$func() as a coderef",
94 expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
95 is a constant sub, optimized to a $want->{$func}[0]
97 is a constant sub, optimized to a $want->{$func}[0]
102 pass("RENDER CALLS TO THOSE CONSTANT SUBS");
104 for $func (sort keys %$want) {
105 # print "# doing $func\n";
106 checkOptree ( name => "call $func",
108 ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
109 bc_opts => '-nobanner',
110 expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
111 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
112 - <\@> lineseq KP ->3
113 1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
114 2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
116 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
117 - <\@> lineseq KP ->3
118 1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
119 2 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
127 checkOptree ( name => 'myyes() as coderef',
128 code => sub () { 1==1 },
130 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
131 is a constant sub, optimized to a SPECIAL
133 is a constant sub, optimized to a SPECIAL
137 checkOptree ( name => 'myyes() as coderef',
138 code => 'sub a() { 1==1 }; print a',
140 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
141 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
142 # - <@> lineseq KP ->5
143 # 1 <;> nextstate(main 810 (eval 47):1) v ->2
145 # 2 <0> pushmark s ->3
146 # 3 <$> const[SPECIAL sv_yes] s ->4
148 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
149 # - <@> lineseq KP ->5
150 # 1 <;> nextstate(main 810 (eval 47):1) v ->2
152 # 2 <0> pushmark s ->3
153 # 3 <$> const(SPECIAL sv_yes) s ->4
157 checkOptree ( name => 'myno() as coderef',
158 code => 'sub a() { 1!=1 }; print a',
160 todo => '- SPECIAL sv_no renders as PVNV 0',
161 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
162 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
163 # - <@> lineseq KP ->5
164 # 1 <;> nextstate(main 810 (eval 47):1) v ->2
166 # 2 <0> pushmark s ->3
167 # 3 <$> const[PVNV 0] s ->4
169 # 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
170 # - <@> lineseq KP ->5
171 # 1 <;> nextstate(main 810 (eval 47):1) v ->2
173 # 2 <0> pushmark s ->3
174 # 3 <$> const(PVNV 0) s ->4
178 checkOptree ( name => 'constant sub returning list',
181 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
182 # 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
183 # - <@> lineseq K ->3
184 # 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
185 # 2 <0> padav[@list:FAKE:m:102] ->3
187 # 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
188 # - <@> lineseq K ->3
189 # 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
190 # 2 <0> padav[@list:FAKE:m:76] ->3
195 printf "myint %d mystr %s myfl %f pi %f\n"
196 , myint, mystr, myfl, pi;
199 checkOptree ( name => 'call many in a print statement',
202 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
203 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
204 # - <@> lineseq KP ->9
205 # 1 <;> nextstate(main 635 optree_constants.t:163) v ->2
207 # 2 <0> pushmark s ->3
208 # 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
209 # 4 <$> const[IV 42] s ->5
210 # 5 <$> const[PV "hithere"] s ->6
211 # 6 <$> const[NV 1.414213] s ->7
212 # 7 <$> const[NV 3.14159] s ->8
214 # 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
215 # - <@> lineseq KP ->9
216 # 1 <;> nextstate(main 635 optree_constants.t:163) v ->2
218 # 2 <0> pushmark s ->3
219 # 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
220 # 4 <$> const(IV 42) s ->5
221 # 5 <$> const(PV "hithere") s ->6
222 # 6 <$> const(NV 1.414213) s ->7
223 # 7 <$> const(NV 3.14159) s ->8
233 Optimized constant subs are stored as bare scalars in the stash
234 (package hash), which formerly held only GVs (typeglobs).
236 But you cant create them manually - you cant assign a scalar to a
237 stash element, and expect it to work like a constant-sub, even if you
240 This is a feature; alternative is too much action-at-a-distance. The
241 following test demonstrates - napier is not seen as a function at all,
242 much less an optimized one.
246 checkOptree ( name => 'not evertnapier',
249 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');