This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
d927f66ef2861486089260e9f909cc1055f3aae1
[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     # 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', ],
70 };
71
72 use constant WEEKDAYS
73     => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
74
75
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 #################################
87 pass("RENDER CONSTANT SUBS RETURNING SCALARS");
88
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]
96 EOT_EOT
97  is a constant sub, optimized to a $want->{$func}[0]
98 EONT_EONT
99
100 }
101
102 pass("RENDER CALLS TO THOSE CONSTANT SUBS");
103
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);
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
115 EOT_EOT
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
120 EONT_EONT
121
122 }
123
124 ##############
125 pass("MORE TESTS");
126
127 checkOptree ( name      => 'myyes() as coderef',
128               code      => sub () { 1==1 },
129               noanchors => 1,
130               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
131  is a constant sub, optimized to a SPECIAL
132 EOT_EOT
133  is a constant sub, optimized to a SPECIAL
134 EONT_EONT
135
136
137 checkOptree ( name      => 'myyes() as coderef',
138               code      => 'sub a() { 1==1 }; print a',
139               noanchors => 1,
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
144 # 4        <@> print sK ->5
145 # 2           <0> pushmark s ->3
146 # 3           <$> const[SPECIAL sv_yes] s ->4
147 EOT_EOT
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
154 EONT_EONT
155
156
157 checkOptree ( name      => 'myno() as coderef',
158               code      => 'sub a() { 1!=1 }; print a',
159               noanchors => 1,
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
165 # 4        <@> print sK ->5
166 # 2           <0> pushmark s ->3
167 # 3           <$> const[PVNV 0] s ->4
168 EOT_EOT
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
175 EONT_EONT
176
177
178 checkOptree ( name      => 'constant sub returning list',
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
184 # 1        <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
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
189 # 1        <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
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
199 checkOptree ( name      => 'call many in a print statement',
200               code      => \&printem,
201               @open_todo,
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
211 # 6           <$> const[NV 1.414213] s ->7
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
222 # 6           <$> const(NV 1.414213) s ->7
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