This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to version-0.6701
[perl5.git] / ext / B / t / optree_constants.t
CommitLineData
d51cf0c9
JC
1#!perl
2
3BEGIN {
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
19use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
20use Config;
21
f9f861ec 22my $tests = 30;
d51cf0c9
JC
23plan tests => $tests;
24SKIP: {
25skip "no perlio in this build", $tests unless $Config::Config{useperlio};
26
09337566
NC
27my @open_todo;
28sub open_todo {
29 if (((caller 0)[10]||{})->{open}) {
30 @open_todo = (skip => "\$^OPEN is set");
31 }
32}
33open_todo;
34
d51cf0c9
JC
35#################################
36
37use constant { # see also t/op/gv.t line 282
f9f861ec
JC
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
50sub myyes() { 1==1 }
51sub myno () { return 1!=1 }
52sub pi () { 3.14159 };
53
54my $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
JC
70};
71
72use constant WEEKDAYS
73 => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
74
75
d51cf0c9
JC
76$::{napier} = \2.71828; # counter-example (doesn't get optimized).
77eval "sub napier ();";
78
79
80# should be able to undefine constant::import here ???
81INIT {
82 # eval 'sub constant::import () {}';
83 # undef *constant::import::{CODE};
84};
85
86#################################
f9f861ec 87pass("RENDER CONSTANT SUBS RETURNING SCALARS");
2018a5c3 88
f9f861ec
JC
89for $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 96EOT_EOT
f9f861ec 97 is a constant sub, optimized to a $want->{$func}[0]
d51cf0c9
JC
98EONT_EONT
99
f9f861ec 100}
d51cf0c9 101
f9f861ec 102pass("RENDER CALLS TO THOSE CONSTANT SUBS");
d51cf0c9 103
f9f861ec
JC
104for $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 1113 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 112- <\@> lineseq KP ->3
d51cf0c9 1131 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
f9f861ec 1142 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
d51cf0c9
JC
115EOT_EOT
1163 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 117- <\@> lineseq KP ->3
d51cf0c9 1181 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
f9f861ec 1192 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
d51cf0c9
JC
120EONT_EONT
121
f9f861ec 122}
d51cf0c9 123
f9f861ec
JC
124##############
125pass("MORE TESTS");
d51cf0c9 126
f9f861ec
JC
127checkOptree ( name => 'myyes() as coderef',
128 code => sub () { 1==1 },
2018a5c3
JC
129 noanchors => 1,
130 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec 131 is a constant sub, optimized to a SPECIAL
2018a5c3 132EOT_EOT
f9f861ec 133 is a constant sub, optimized to a SPECIAL
2018a5c3
JC
134EONT_EONT
135
136
f9f861ec
JC
137checkOptree ( name => 'myyes() as coderef',
138 code => 'sub a() { 1==1 }; print a',
2018a5c3
JC
139 noanchors => 1,
140 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec
JC
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 147EOT_EOT
f9f861ec
JC
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
JC
154EONT_EONT
155
d51cf0c9 156
f9f861ec
JC
157checkOptree ( 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
JC
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 168EOT_EOT
f9f861ec
JC
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
JC
175EONT_EONT
176
177
2018a5c3 178checkOptree ( name => 'constant sub returning list',
d51cf0c9
JC
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
JC
185# 2 <0> padav[@list:FAKE:m:102] ->3
186EOT_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
JC
190# 2 <0> padav[@list:FAKE:m:76] ->3
191EONT_EONT
192
193
194sub printem {
195 printf "myint %d mystr %s myfl %f pi %f\n"
196 , myint, mystr, myfl, pi;
197}
198
2018a5c3 199checkOptree ( name => 'call many in a print statement',
d51cf0c9 200 code => \&printem,
09337566 201 @open_todo,
d51cf0c9
JC
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
JC
212# 7 <$> const[NV 3.14159] s ->8
213EOT_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
JC
223# 7 <$> const(NV 3.14159) s ->8
224EONT_EONT
225
226
227} #skip
228
229__END__
230
231=head NB
232
233Optimized constant subs are stored as bare scalars in the stash
234(package hash), which formerly held only GVs (typeglobs).
235
236But you cant create them manually - you cant assign a scalar to a
237stash element, and expect it to work like a constant-sub, even if you
238provide a prototype.
239
240This is a feature; alternative is too much action-at-a-distance. The
241following test demonstrates - napier is not seen as a function at all,
242much less an optimized one.
243
244=cut
245
246checkOptree ( name => 'not evertnapier',
247 code => \&napier,
248 noanchors => 1,
249 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
250 has no START
251EOT_EOT
252 has no START
253EONT_EONT
254
255