This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Un-TODO some B tests
[perl5.git] / ext / B / t / optree_constants.t
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 = 30;
23 plan tests => $tests;
24 SKIP: {
25 skip "no perlio in this build", $tests unless $Config::Config{useperlio};
26
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
35 #################################
36
37 use constant {          # see also t/op/gv.t line 282
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     myaref      => [ 'RV', '\\\\' ],
62     myglob      => [ 'RV', '\\\\' ],
63     myrex       => [ 'RV', '\\\\' ],
64     mysub       => [ 'RV', '\\\\' ],
65     myunsub     => [ 'RV', '\\\\' ],
66     # these are not inlined, at least not per BC::Concise
67     #myyes      => [ 'RV', ],
68     #myno       => [ 'RV', ],
69 };
70
71 use constant WEEKDAYS
72     => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
73
74
75 $::{napier} = \2.71828; # counter-example (doesn't get optimized).
76 eval "sub napier ();";
77
78
79 # should be able to undefine constant::import here ???
80 INIT { 
81     # eval 'sub constant::import () {}';
82     # undef *constant::import::{CODE};
83 };
84
85 #################################
86 pass("RENDER CONSTANT SUBS RETURNING SCALARS");
87
88 for $func (sort keys %$want) {
89     # no strict 'refs'; # why not needed ?
90     checkOptree ( name      => "$func() as a coderef",
91                   code      => \&{$func},
92                   noanchors => 1,
93                   expect    => <<EOT_EOT, expect_nt => <<EONT_EONT);
94  is a constant sub, optimized to a $want->{$func}[0]
95 EOT_EOT
96  is a constant sub, optimized to a $want->{$func}[0]
97 EONT_EONT
98
99 }
100
101 pass("RENDER CALLS TO THOSE CONSTANT SUBS");
102
103 for $func (sort keys %$want) {
104     # print "# doing $func\n";
105     checkOptree ( name    => "call $func",
106                   code    => "$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 1163 OptreeCheck.pm:511]:1) v ->2
113 2        <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
114 EOT_EOT
115 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
116 -     <\@> lineseq KP ->3
117 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
118 2        <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
119 EONT_EONT
120
121 }
122
123 ##############
124 pass("MORE TESTS");
125
126 checkOptree ( name      => 'myyes() as coderef',
127               code      => sub () { 1==1 },
128               noanchors => 1,
129               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
130  is a constant sub, optimized to a SPECIAL
131 EOT_EOT
132  is a constant sub, optimized to a SPECIAL
133 EONT_EONT
134
135
136 checkOptree ( name      => 'myyes() as coderef',
137               code      => 'sub a() { 1==1 }; print a',
138               noanchors => 1,
139               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
140 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
141 # -     <@> lineseq KP ->5
142 # 1        <;> nextstate(main 810 (eval 47):1) v ->2
143 # 4        <@> print sK ->5
144 # 2           <0> pushmark s ->3
145 # 3           <$> const[SPECIAL sv_yes] s ->4
146 EOT_EOT
147 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
148 # -     <@> lineseq KP ->5
149 # 1        <;> nextstate(main 810 (eval 47):1) v ->2
150 # 4        <@> print sK ->5
151 # 2           <0> pushmark s ->3
152 # 3           <$> const(SPECIAL sv_yes) s ->4
153 EONT_EONT
154
155
156 checkOptree ( name      => 'myno() as coderef',
157               code      => 'sub a() { 1!=1 }; print a',
158               noanchors => 1,
159               todo      => '- SPECIAL sv_no renders as PVNV 0',
160               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
161 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
162 # -     <@> lineseq KP ->5
163 # 1        <;> nextstate(main 810 (eval 47):1) v ->2
164 # 4        <@> print sK ->5
165 # 2           <0> pushmark s ->3
166 # 3           <$> const[PVNV 0] s ->4
167 EOT_EOT
168 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
169 # -     <@> lineseq KP ->5
170 # 1        <;> nextstate(main 810 (eval 47):1) v ->2
171 # 4        <@> print sK ->5
172 # 2           <0> pushmark s ->3
173 # 3           <$> const(PVNV 0) s ->4
174 EONT_EONT
175
176
177 checkOptree ( name      => 'constant sub returning list',
178               code      => \&WEEKDAYS,
179               noanchors => 1,
180               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
181 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
182 # -     <@> lineseq K ->3
183 # 1        <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
184 # 2        <0> padav[@list:FAKE:m:102] ->3
185 EOT_EOT
186 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
187 # -     <@> lineseq K ->3
188 # 1        <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
189 # 2        <0> padav[@list:FAKE:m:76] ->3
190 EONT_EONT
191
192
193 sub printem {
194     printf "myint %d mystr %s myfl %f pi %f\n"
195         , myint, mystr, myfl, pi;
196 }
197
198 checkOptree ( name      => 'call many in a print statement',
199               code      => \&printem,
200               @open_todo,
201               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
202 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
203 # -     <@> lineseq KP ->9
204 # 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
205 # 8        <@> prtf sK ->9
206 # 2           <0> pushmark s ->3
207 # 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
208 # 4           <$> const[IV 42] s ->5
209 # 5           <$> const[PV "hithere"] s ->6
210 # 6           <$> const[NV 1.414213] s ->7
211 # 7           <$> const[NV 3.14159] s ->8
212 EOT_EOT
213 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
214 # -     <@> lineseq KP ->9
215 # 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
216 # 8        <@> prtf sK ->9
217 # 2           <0> pushmark s ->3
218 # 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
219 # 4           <$> const(IV 42) s ->5
220 # 5           <$> const(PV "hithere") s ->6
221 # 6           <$> const(NV 1.414213) s ->7
222 # 7           <$> const(NV 3.14159) s ->8
223 EONT_EONT
224
225
226 } #skip
227
228 __END__
229
230 =head NB
231
232 Optimized constant subs are stored as bare scalars in the stash
233 (package hash), which formerly held only GVs (typeglobs).
234
235 But you cant create them manually - you cant assign a scalar to a
236 stash element, and expect it to work like a constant-sub, even if you
237 provide a prototype.
238
239 This is a feature; alternative is too much action-at-a-distance.  The
240 following test demonstrates - napier is not seen as a function at all,
241 much less an optimized one.
242
243 =cut
244
245 checkOptree ( name      => 'not evertnapier',
246               code      => \&napier,
247               noanchors => 1,
248               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
249  has no START
250 EOT_EOT
251  has no START
252 EONT_EONT
253
254