This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change .t to use new (?^...)
[perl5.git] / ext / B / t / optree_constants.t
CommitLineData
d51cf0c9
JC
1#!perl
2
3BEGIN {
74517a3a 4 unshift @INC, 't';
d51cf0c9
JC
5 require Config;
6 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
7 print "1..0 # Skip -- Perl configured without B module\n";
8 exit 0;
9 }
10 # require 'test.pl'; # now done by OptreeCheck
11}
12
13use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
14use Config;
15
f9f861ec 16my $tests = 30;
d51cf0c9
JC
17plan tests => $tests;
18SKIP: {
19skip "no perlio in this build", $tests unless $Config::Config{useperlio};
20
21#################################
22
23use constant { # see also t/op/gv.t line 282
f9f861ec
JC
24 myaref => [ 1,2,3 ],
25 myfl => 1.414213,
26 myglob => \*STDIN,
27 myhref => { a => 1 },
28 myint => 42,
29 myrex => qr/foo/,
30 mystr => 'hithere',
31 mysub => \&ok,
32 myundef => undef,
33 myunsub => \&nosuch,
34};
35
36sub myyes() { 1==1 }
37sub myno () { return 1!=1 }
38sub pi () { 3.14159 };
39
4df7f6af
NC
40my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
41
f9f861ec 42my $want = { # expected types, how value renders in-line, todos (maybe)
f9f861ec 43 mystr => [ 'PV', '"'.mystr.'"' ],
4df7f6af 44 myhref => [ $RV_class, '\\\\HASH'],
f9f861ec 45 pi => [ 'NV', pi ],
4df7f6af
NC
46 myglob => [ $RV_class, '\\\\' ],
47 mysub => [ $RV_class, '\\\\' ],
48 myunsub => [ $RV_class, '\\\\' ],
f9f861ec 49 # these are not inlined, at least not per BC::Concise
4df7f6af
NC
50 #myyes => [ $RV_class, ],
51 #myno => [ $RV_class, ],
e412117e 52 $] > 5.009 ? (
4df7f6af 53 myaref => [ $RV_class, '\\\\' ],
e412117e
NC
54 myfl => [ 'NV', myfl ],
55 myint => [ 'IV', myint ],
f7c278bf 56 $] >= 5.011 ? (
4c2c679f 57 myrex => [ $RV_class, '\\\\"\\(?^:Foo\\)"' ],
f7c278bf 58 ) : (
4df7f6af 59 myrex => [ $RV_class, '\\\\' ],
f7c278bf 60 ),
e412117e
NC
61 myundef => [ 'NULL', ],
62 ) : (
63 myaref => [ 'PVIV', '' ],
64 myfl => [ 'PVNV', myfl ],
65 myint => [ 'PVIV', myint ],
66 myrex => [ 'PVNV', '' ],
67 myundef => [ 'PVIV', ],
68 )
d51cf0c9
JC
69};
70
71use constant WEEKDAYS
72 => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
73
74
d51cf0c9
JC
75$::{napier} = \2.71828; # counter-example (doesn't get optimized).
76eval "sub napier ();";
77
78
79# should be able to undefine constant::import here ???
80INIT {
81 # eval 'sub constant::import () {}';
82 # undef *constant::import::{CODE};
83};
84
85#################################
f9f861ec 86pass("RENDER CONSTANT SUBS RETURNING SCALARS");
2018a5c3 87
f9f861ec
JC
88for $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]
2018a5c3 95EOT_EOT
f9f861ec 96 is a constant sub, optimized to a $want->{$func}[0]
d51cf0c9
JC
97EONT_EONT
98
f9f861ec 99}
d51cf0c9 100
f9f861ec 101pass("RENDER CALLS TO THOSE CONSTANT SUBS");
d51cf0c9 102
f9f861ec
JC
103for $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);
d51cf0c9 1103 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 111- <\@> lineseq KP ->3
be2b1c74 1121 <;> dbstate(main 833 (eval 44):1) v ->2
f9f861ec 1132 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
d51cf0c9
JC
114EOT_EOT
1153 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec 116- <\@> lineseq KP ->3
be2b1c74 1171 <;> dbstate(main 833 (eval 44):1) v ->2
f9f861ec 1182 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
d51cf0c9
JC
119EONT_EONT
120
f9f861ec 121}
d51cf0c9 122
f9f861ec
JC
123##############
124pass("MORE TESTS");
d51cf0c9 125
f9f861ec
JC
126checkOptree ( name => 'myyes() as coderef',
127 code => sub () { 1==1 },
2018a5c3
JC
128 noanchors => 1,
129 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec 130 is a constant sub, optimized to a SPECIAL
2018a5c3 131EOT_EOT
f9f861ec 132 is a constant sub, optimized to a SPECIAL
2018a5c3
JC
133EONT_EONT
134
135
f9f861ec 136checkOptree ( name => 'myyes() as coderef',
36932700 137 prog => 'sub a() { 1==1 }; print a',
2018a5c3 138 noanchors => 1,
e412117e 139 strip_open_hints => 1,
2018a5c3 140 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36932700
NC
141# 6 <@> leave[1 ref] vKP/REFC ->(end)
142# 1 <0> enter ->2
e412117e 143# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
144# 5 <@> print vK ->6
145# 3 <0> pushmark s ->4
146# 4 <$> const[SPECIAL sv_yes] s ->5
2018a5c3 147EOT_EOT
36932700
NC
148# 6 <@> leave[1 ref] vKP/REFC ->(end)
149# 1 <0> enter ->2
e412117e 150# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
151# 5 <@> print vK ->6
152# 3 <0> pushmark s ->4
153# 4 <$> const(SPECIAL sv_yes) s ->5
2018a5c3
JC
154EONT_EONT
155
d51cf0c9 156
36932700
NC
157# Need to do this as a prog, not code, as only the first constant to use
158# PL_sv_no actually gets to use the real thing - every one following is
159# copied.
f9f861ec 160checkOptree ( name => 'myno() as coderef',
36932700 161 prog => 'sub a() { 1!=1 }; print a',
d51cf0c9 162 noanchors => 1,
e412117e 163 strip_open_hints => 1,
d51cf0c9 164 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36932700
NC
165# 6 <@> leave[1 ref] vKP/REFC ->(end)
166# 1 <0> enter ->2
e412117e 167# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
168# 5 <@> print vK ->6
169# 3 <0> pushmark s ->4
170# 4 <$> const[SPECIAL sv_no] s ->5
d51cf0c9 171EOT_EOT
36932700
NC
172# 6 <@> leave[1 ref] vKP/REFC ->(end)
173# 1 <0> enter ->2
e412117e 174# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700
NC
175# 5 <@> print vK ->6
176# 3 <0> pushmark s ->4
177# 4 <$> const(SPECIAL sv_no) s ->5
d51cf0c9
JC
178EONT_EONT
179
180
e412117e 181my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d51cf0c9
JC
182# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
183# - <@> lineseq K ->3
dbeafbd1
NC
184# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
185# 2 <0> padav[@list:FAKE:m:96] ->3
d51cf0c9
JC
186EOT_EOT
187# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
188# - <@> lineseq K ->3
dbeafbd1
NC
189# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
190# 2 <0> padav[@list:FAKE:m:71] ->3
d51cf0c9
JC
191EONT_EONT
192
e412117e
NC
193if($] < 5.009) {
194 # 5.8.x doesn't add the m flag to padav
195 s/FAKE:m:\d+/FAKE/ foreach ($expect, $expect_nt);
196}
197
198checkOptree ( name => 'constant sub returning list',
199 code => \&WEEKDAYS,
200 noanchors => 1,
201 expect => $expect, expect_nt => $expect_nt);
202
d51cf0c9
JC
203
204sub printem {
205 printf "myint %d mystr %s myfl %f pi %f\n"
206 , myint, mystr, myfl, pi;
207}
208
e412117e 209my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d51cf0c9
JC
210# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
211# - <@> lineseq KP ->9
be2b1c74 212# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9
JC
213# 8 <@> prtf sK ->9
214# 2 <0> pushmark s ->3
215# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
216# 4 <$> const[IV 42] s ->5
217# 5 <$> const[PV "hithere"] s ->6
f9f861ec 218# 6 <$> const[NV 1.414213] s ->7
d51cf0c9
JC
219# 7 <$> const[NV 3.14159] s ->8
220EOT_EOT
221# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
222# - <@> lineseq KP ->9
be2b1c74 223# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9
JC
224# 8 <@> prtf sK ->9
225# 2 <0> pushmark s ->3
226# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
227# 4 <$> const(IV 42) s ->5
228# 5 <$> const(PV "hithere") s ->6
f9f861ec 229# 6 <$> const(NV 1.414213) s ->7
d51cf0c9
JC
230# 7 <$> const(NV 3.14159) s ->8
231EONT_EONT
232
e412117e
NC
233if($] < 5.009) {
234 # 5.8.x's use constant has larger types
235 foreach ($expect, $expect_nt) {
236 s/IV 42/PV$&/;
237 s/NV 1.41/PV$&/;
238 }
239}
240
241checkOptree ( name => 'call many in a print statement',
242 code => \&printem,
243 strip_open_hints => 1,
244 expect => $expect, expect_nt => $expect_nt);
d51cf0c9
JC
245
246} #skip
247
248__END__
249
250=head NB
251
252Optimized constant subs are stored as bare scalars in the stash
253(package hash), which formerly held only GVs (typeglobs).
254
255But you cant create them manually - you cant assign a scalar to a
256stash element, and expect it to work like a constant-sub, even if you
257provide a prototype.
258
259This is a feature; alternative is too much action-at-a-distance. The
260following test demonstrates - napier is not seen as a function at all,
261much less an optimized one.
262
263=cut
264
265checkOptree ( name => 'not evertnapier',
266 code => \&napier,
267 noanchors => 1,
268 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
269 has no START
270EOT_EOT
271 has no START
272EONT_EONT
273
274