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 | |
f9f861ec |
22 | my $tests = 30; |
d51cf0c9 |
23 | plan tests => $tests; |
24 | SKIP: { |
25 | skip "no perlio in this build", $tests unless $Config::Config{useperlio}; |
26 | |
09337566 |
27 | my @open_todo; |
28 | sub open_todo { |
29 | if (((caller 0)[10]||{})->{open}) { |
30 | @open_todo = (skip => "\$^OPEN is set"); |
31 | } |
32 | } |
33 | open_todo; |
34 | |
d51cf0c9 |
35 | ################################# |
36 | |
37 | use constant { # see also t/op/gv.t line 282 |
f9f861ec |
38 | myaref => [ 1,2,3 ], |
39 | myfl => 1.414213, |
40 | myglob => \*STDIN, |
41 | myhref => { a => 1 }, |
42 | myint => 42, |
43 | myrex => qr/foo/, |
44 | mystr => 'hithere', |
45 | mysub => \&ok, |
46 | myundef => undef, |
47 | myunsub => \&nosuch, |
48 | }; |
49 | |
50 | sub myyes() { 1==1 } |
51 | sub myno () { return 1!=1 } |
52 | sub pi () { 3.14159 }; |
53 | |
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', ], |
60 | pi => [ 'NV', pi ], |
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 |
68 | #myyes => [ 'RV', ], |
69 | #myno => [ 'RV', ], |
d51cf0c9 |
70 | }; |
71 | |
72 | use constant WEEKDAYS |
73 | => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday ); |
74 | |
75 | |
d51cf0c9 |
76 | $::{napier} = \2.71828; # counter-example (doesn't get optimized). |
77 | eval "sub napier ();"; |
78 | |
79 | |
80 | # should be able to undefine constant::import here ??? |
81 | INIT { |
82 | # eval 'sub constant::import () {}'; |
83 | # undef *constant::import::{CODE}; |
84 | }; |
85 | |
86 | ################################# |
f9f861ec |
87 | pass("RENDER CONSTANT SUBS RETURNING SCALARS"); |
2018a5c3 |
88 | |
f9f861ec |
89 | for $func (sort keys %$want) { |
90 | # no strict 'refs'; # why not needed ? |
91 | checkOptree ( name => "$func() as a coderef", |
92 | code => \&{$func}, |
93 | noanchors => 1, |
94 | expect => <<EOT_EOT, expect_nt => <<EONT_EONT); |
95 | is a constant sub, optimized to a $want->{$func}[0] |
2018a5c3 |
96 | EOT_EOT |
f9f861ec |
97 | is a constant sub, optimized to a $want->{$func}[0] |
d51cf0c9 |
98 | EONT_EONT |
99 | |
f9f861ec |
100 | } |
d51cf0c9 |
101 | |
f9f861ec |
102 | pass("RENDER CALLS TO THOSE CONSTANT SUBS"); |
d51cf0c9 |
103 | |
f9f861ec |
104 | for $func (sort keys %$want) { |
105 | # print "# doing $func\n"; |
106 | checkOptree ( name => "call $func", |
107 | code => "$func", |
108 | ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (), |
109 | bc_opts => '-nobanner', |
110 | expect => <<EOT_EOT, expect_nt => <<EONT_EONT); |
d51cf0c9 |
111 | 3 <1> leavesub[2 refs] K/REFC,1 ->(end) |
f9f861ec |
112 | - <\@> lineseq KP ->3 |
d51cf0c9 |
113 | 1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 |
f9f861ec |
114 | 2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3 |
d51cf0c9 |
115 | EOT_EOT |
116 | 3 <1> leavesub[2 refs] K/REFC,1 ->(end) |
f9f861ec |
117 | - <\@> lineseq KP ->3 |
d51cf0c9 |
118 | 1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 |
f9f861ec |
119 | 2 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3 |
d51cf0c9 |
120 | EONT_EONT |
121 | |
f9f861ec |
122 | } |
d51cf0c9 |
123 | |
f9f861ec |
124 | ############## |
125 | pass("MORE TESTS"); |
d51cf0c9 |
126 | |
f9f861ec |
127 | checkOptree ( name => 'myyes() as coderef', |
128 | code => sub () { 1==1 }, |
2018a5c3 |
129 | noanchors => 1, |
130 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
f9f861ec |
131 | is a constant sub, optimized to a SPECIAL |
2018a5c3 |
132 | EOT_EOT |
f9f861ec |
133 | is a constant sub, optimized to a SPECIAL |
2018a5c3 |
134 | EONT_EONT |
135 | |
136 | |
f9f861ec |
137 | checkOptree ( name => 'myyes() as coderef', |
138 | code => 'sub a() { 1==1 }; print a', |
2018a5c3 |
139 | noanchors => 1, |
140 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
f9f861ec |
141 | # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) |
142 | # - <@> lineseq KP ->5 |
143 | # 1 <;> nextstate(main 810 (eval 47):1) v ->2 |
144 | # 4 <@> print sK ->5 |
145 | # 2 <0> pushmark s ->3 |
146 | # 3 <$> const[SPECIAL sv_yes] s ->4 |
2018a5c3 |
147 | EOT_EOT |
f9f861ec |
148 | # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) |
149 | # - <@> lineseq KP ->5 |
150 | # 1 <;> nextstate(main 810 (eval 47):1) v ->2 |
151 | # 4 <@> print sK ->5 |
152 | # 2 <0> pushmark s ->3 |
153 | # 3 <$> const(SPECIAL sv_yes) s ->4 |
2018a5c3 |
154 | EONT_EONT |
155 | |
d51cf0c9 |
156 | |
f9f861ec |
157 | checkOptree ( name => 'myno() as coderef', |
158 | code => 'sub a() { 1!=1 }; print a', |
d51cf0c9 |
159 | noanchors => 1, |
f9f861ec |
160 | todo => '- SPECIAL sv_no renders as PVNV 0', |
d51cf0c9 |
161 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
f9f861ec |
162 | # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) |
163 | # - <@> lineseq KP ->5 |
164 | # 1 <;> nextstate(main 810 (eval 47):1) v ->2 |
165 | # 4 <@> print sK ->5 |
166 | # 2 <0> pushmark s ->3 |
167 | # 3 <$> const[PVNV 0] s ->4 |
d51cf0c9 |
168 | EOT_EOT |
f9f861ec |
169 | # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) |
170 | # - <@> lineseq KP ->5 |
171 | # 1 <;> nextstate(main 810 (eval 47):1) v ->2 |
172 | # 4 <@> print sK ->5 |
173 | # 2 <0> pushmark s ->3 |
174 | # 3 <$> const(PVNV 0) s ->4 |
d51cf0c9 |
175 | EONT_EONT |
176 | |
177 | |
2018a5c3 |
178 | checkOptree ( name => 'constant sub returning list', |
d51cf0c9 |
179 | code => \&WEEKDAYS, |
180 | noanchors => 1, |
181 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
182 | # 3 <1> leavesub[2 refs] K/REFC,1 ->(end) |
183 | # - <@> lineseq K ->3 |
d5ec2987 |
184 | # 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2 |
d51cf0c9 |
185 | # 2 <0> padav[@list:FAKE:m:102] ->3 |
186 | EOT_EOT |
187 | # 3 <1> leavesub[2 refs] K/REFC,1 ->(end) |
188 | # - <@> lineseq K ->3 |
d5ec2987 |
189 | # 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2 |
d51cf0c9 |
190 | # 2 <0> padav[@list:FAKE:m:76] ->3 |
191 | EONT_EONT |
192 | |
193 | |
194 | sub printem { |
195 | printf "myint %d mystr %s myfl %f pi %f\n" |
196 | , myint, mystr, myfl, pi; |
197 | } |
198 | |
2018a5c3 |
199 | checkOptree ( name => 'call many in a print statement', |
d51cf0c9 |
200 | code => \&printem, |
09337566 |
201 | @open_todo, |
d51cf0c9 |
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 |
206 | # 8 <@> prtf sK ->9 |
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 |
f9f861ec |
211 | # 6 <$> const[NV 1.414213] s ->7 |
d51cf0c9 |
212 | # 7 <$> const[NV 3.14159] s ->8 |
213 | EOT_EOT |
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 |
217 | # 8 <@> prtf sK ->9 |
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 |
f9f861ec |
222 | # 6 <$> const(NV 1.414213) s ->7 |
d51cf0c9 |
223 | # 7 <$> const(NV 3.14159) s ->8 |
224 | EONT_EONT |
225 | |
226 | |
227 | } #skip |
228 | |
229 | __END__ |
230 | |
231 | =head NB |
232 | |
233 | Optimized constant subs are stored as bare scalars in the stash |
234 | (package hash), which formerly held only GVs (typeglobs). |
235 | |
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 |
238 | provide a prototype. |
239 | |
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. |
243 | |
244 | =cut |
245 | |
246 | checkOptree ( name => 'not evertnapier', |
247 | code => \&napier, |
248 | noanchors => 1, |
249 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); |
250 | has no START |
251 | EOT_EOT |
252 | has no START |
253 | EONT_EONT |
254 | |
255 | |