This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
c6662452d4a00be5907e3ae5511931e3b3dd1a83
[perl5.git] / ext / B / t / optree_specials.t
1 #!./perl
2
3 # This tests the B:: module(s) with CHECK, BEGIN, END and INIT blocks. The
4 # text excerpts below marked with "# " in front are the expected output. They
5 # are there twice, EOT for threading, and EONT for a non-threading Perl. The
6 # output is matched losely. If the match fails even though the "got" and
7 # "expected" output look exactly the same, then watch for trailing, invisible
8 # spaces.
9
10 BEGIN {
11     if ($ENV{PERL_CORE}){
12         chdir('t') if -d 't';
13         @INC = ('.', '../lib', '../ext/B/t');
14     } else {
15         unshift @INC, 't';
16         push @INC, "../../t";
17     }
18     require Config;
19     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
20         print "1..0 # Skip -- Perl configured without B module\n";
21         exit 0;
22     }
23     # require 'test.pl'; # now done by OptreeCheck
24 }
25
26 # import checkOptree(), and %gOpts (containing test state)
27 use OptreeCheck;        # ALSO DOES @ARGV HANDLING !!!!!!
28 use Config;
29
30 plan tests => 7;
31
32 require_ok("B::Concise");
33
34 my $out = runperl(
35     switches => ["-MO=Concise,BEGIN,CHECK,INIT,END,-exec"],
36     prog => q{$a=$b && print q/foo/},
37     stderr => 1 );
38
39 #print "out:$out\n";
40
41 my $src = q[our ($beg, $chk, $init, $end) = qq{'foo'}; BEGIN { $beg++ } CHECK { $chk++ } INIT { $init++ } END { $end++ }];
42
43
44 my @warnings_todo;
45 @warnings_todo = (todo =>
46    "Change 23768 (Remove Carp from warnings.pm) alters expected output, not"
47    . "propagated to 5.8.x")
48     if $] < 5.009;
49
50 my @open_todo;
51 sub open_todo {
52     if (((caller 0)[10]||{})->{open}) {
53         @open_todo = (skip => "\$^OPEN is set");
54     }
55 }
56 open_todo;
57
58 checkOptree ( name      => 'BEGIN',
59               bcopts    => 'BEGIN',
60               prog      => $src,
61               @warnings_todo,
62               @open_todo,
63               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
64 # BEGIN 1:
65 # b  <1> leavesub[1 ref] K/REFC,1 ->(end)
66 # -     <@> lineseq KP ->b
67 # 1        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->2
68 # 3        <1> require sK/1 ->4
69 # 2           <$> const[PV "warnings.pm"] s/BARE ->3
70 # 4        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->5
71 # -        <@> lineseq K ->-
72 # 5           <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$ ->6
73 # a           <1> entersub[t1] KS*/TARG,2 ->b
74 # 6              <0> pushmark s ->7
75 # 7              <$> const[PV "warnings"] sM ->8
76 # 8              <$> const[PV "qw"] sM ->9
77 # 9              <$> method_named[PV "import"] ->a
78 # BEGIN 2:
79 # f  <1> leavesub[1 ref] K/REFC,1 ->(end)
80 # -     <@> lineseq KP ->f
81 # c        <;> nextstate(main 2 -e:1) v:{ ->d
82 # e        <1> postinc[t3] sK/1 ->f
83 # -           <1> ex-rv2sv sKRM/1 ->e
84 # d              <#> gvsv[*beg] s ->e
85 EOT_EOT
86 # BEGIN 1:
87 # b  <1> leavesub[1 ref] K/REFC,1 ->(end)
88 # -     <@> lineseq KP ->b
89 # 1        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->2
90 # 3        <1> require sK/1 ->4
91 # 2           <$> const(PV "warnings.pm") s/BARE ->3
92 # 4        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->5
93 # -        <@> lineseq K ->-
94 # 5           <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$ ->6
95 # a           <1> entersub[t1] KS*/TARG,2 ->b
96 # 6              <0> pushmark s ->7
97 # 7              <$> const(PV "warnings") sM ->8
98 # 8              <$> const(PV "qw") sM ->9
99 # 9              <$> method_named(PV "import") ->a
100 # BEGIN 2:
101 # f  <1> leavesub[1 ref] K/REFC,1 ->(end)
102 # -     <@> lineseq KP ->f
103 # c        <;> nextstate(main 2 -e:1) v:{ ->d
104 # e        <1> postinc[t2] sK/1 ->f
105 # -           <1> ex-rv2sv sKRM/1 ->e
106 # d              <$> gvsv(*beg) s ->e
107 EONT_EONT
108
109
110 checkOptree ( name      => 'END',
111               bcopts    => 'END',
112               prog      => $src,
113               @open_todo,
114               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
115 # END 1:
116 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
117 # -     <@> lineseq KP ->4
118 # 1        <;> nextstate(main 5 -e:6) v:{ ->2
119 # 3        <1> postinc[t3] sK/1 ->4
120 # -           <1> ex-rv2sv sKRM/1 ->3
121 # 2              <#> gvsv[*end] s ->3
122 EOT_EOT
123 # END 1:
124 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
125 # -     <@> lineseq KP ->4
126 # 1        <;> nextstate(main 5 -e:6) v:{ ->2
127 # 3        <1> postinc[t2] sK/1 ->4
128 # -           <1> ex-rv2sv sKRM/1 ->3
129 # 2              <$> gvsv(*end) s ->3
130 EONT_EONT
131
132
133 checkOptree ( name      => 'CHECK',
134               bcopts    => 'CHECK',
135               prog      => $src,
136               @open_todo,
137               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
138 # CHECK 1:
139 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
140 # -     <@> lineseq KP ->4
141 # 1        <;> nextstate(main 3 -e:4) v:{ ->2
142 # 3        <1> postinc[t3] sK/1 ->4
143 # -           <1> ex-rv2sv sKRM/1 ->3
144 # 2              <#> gvsv[*chk] s ->3
145 EOT_EOT
146 # CHECK 1:
147 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
148 # -     <@> lineseq KP ->4
149 # 1        <;> nextstate(main 3 -e:4) v:{ ->2
150 # 3        <1> postinc[t2] sK/1 ->4
151 # -           <1> ex-rv2sv sKRM/1 ->3
152 # 2              <$> gvsv(*chk) s ->3
153 EONT_EONT
154
155
156 checkOptree ( name      => 'INIT',
157               bcopts    => 'INIT',
158               #todo     => 'get working',
159               prog      => $src,
160               @open_todo,
161               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
162 # INIT 1:
163 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
164 # -     <@> lineseq KP ->4
165 # 1        <;> nextstate(main 4 -e:5) v:{ ->2
166 # 3        <1> postinc[t3] sK/1 ->4
167 # -           <1> ex-rv2sv sKRM/1 ->3
168 # 2              <#> gvsv[*init] s ->3
169 EOT_EOT
170 # INIT 1:
171 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
172 # -     <@> lineseq KP ->4
173 # 1        <;> nextstate(main 4 -e:5) v:{ ->2
174 # 3        <1> postinc[t2] sK/1 ->4
175 # -           <1> ex-rv2sv sKRM/1 ->3
176 # 2              <$> gvsv(*init) s ->3
177 EONT_EONT
178
179
180 checkOptree ( name      => 'all of BEGIN END INIT CHECK -exec',
181               bcopts    => [qw/ BEGIN END INIT CHECK -exec /],
182               prog      => $src,
183               @warnings_todo,
184               @open_todo,
185               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
186 # BEGIN 1:
187 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
188 # 2  <$> const[PV "warnings.pm"] s/BARE
189 # 3  <1> require sK/1
190 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
191 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
192 # 6  <0> pushmark s
193 # 7  <$> const[PV "warnings"] sM
194 # 8  <$> const[PV "qw"] sM
195 # 9  <$> method_named[PV "unimport"] 
196 # a  <1> entersub[t1] KS*/TARG,2
197 # b  <1> leavesub[1 ref] K/REFC,1
198 # BEGIN 2:
199 # c  <;> nextstate(main 2 -e:1) v:{
200 # d  <#> gvsv[*beg] s
201 # e  <1> postinc[t3] sK/1
202 # f  <1> leavesub[1 ref] K/REFC,1
203 # END 1:
204 # g  <;> nextstate(main 5 -e:1) v:{
205 # h  <#> gvsv[*end] s
206 # i  <1> postinc[t3] sK/1
207 # j  <1> leavesub[1 ref] K/REFC,1
208 # INIT 1:
209 # k  <;> nextstate(main 4 -e:1) v:{
210 # l  <#> gvsv[*init] s
211 # m  <1> postinc[t3] sK/1
212 # n  <1> leavesub[1 ref] K/REFC,1
213 # CHECK 1:
214 # o  <;> nextstate(main 3 -e:1) v:{
215 # p  <#> gvsv[*chk] s
216 # q  <1> postinc[t3] sK/1
217 # r  <1> leavesub[1 ref] K/REFC,1
218 EOT_EOT
219 # BEGIN 1:
220 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
221 # 2  <$> const(PV "warnings.pm") s/BARE
222 # 3  <1> require sK/1
223 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
224 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
225 # 6  <0> pushmark s
226 # 7  <$> const(PV "warnings") sM
227 # 8  <$> const(PV "qw") sM
228 # 9  <$> method_named(PV "unimport") 
229 # a  <1> entersub[t1] KS*/TARG,2
230 # b  <1> leavesub[1 ref] K/REFC,1
231 # BEGIN 2:
232 # c  <;> nextstate(main 2 -e:1) v:{
233 # d  <$> gvsv(*beg) s
234 # e  <1> postinc[t2] sK/1
235 # f  <1> leavesub[1 ref] K/REFC,1
236 # END 1:
237 # g  <;> nextstate(main 5 -e:1) v:{
238 # h  <$> gvsv(*end) s
239 # i  <1> postinc[t2] sK/1
240 # j  <1> leavesub[1 ref] K/REFC,1
241 # INIT 1:
242 # k  <;> nextstate(main 4 -e:1) v:{
243 # l  <$> gvsv(*init) s
244 # m  <1> postinc[t2] sK/1
245 # n  <1> leavesub[1 ref] K/REFC,1
246 # CHECK 1:
247 # o  <;> nextstate(main 3 -e:1) v:{
248 # p  <$> gvsv(*chk) s
249 # q  <1> postinc[t2] sK/1
250 # r  <1> leavesub[1 ref] K/REFC,1
251 EONT_EONT
252
253
254 # perl "-I../lib" -MO=Concise,BEGIN,CHECK,INIT,END,-exec -e '$a=$b && print q/foo/'
255
256
257
258 checkOptree ( name      => 'regression test for patch 25352',
259               bcopts    => [qw/ BEGIN END INIT CHECK -exec /],
260               prog      => 'print q/foo/',
261               @warnings_todo,
262               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
263 # BEGIN 1:
264 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
265 # 2  <$> const[PV "warnings.pm"] s/BARE
266 # 3  <1> require sK/1
267 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
268 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
269 # 6  <0> pushmark s
270 # 7  <$> const[PV "warnings"] sM
271 # 8  <$> const[PV "qw"] sM
272 # 9  <$> method_named[PV "unimport"] 
273 # a  <1> entersub[t1] KS*/TARG,2
274 # b  <1> leavesub[1 ref] K/REFC,1
275 EOT_EOT
276 # BEGIN 1:
277 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
278 # 2  <$> const(PV "warnings.pm") s/BARE
279 # 3  <1> require sK/1
280 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
281 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
282 # 6  <0> pushmark s
283 # 7  <$> const(PV "warnings") sM
284 # 8  <$> const(PV "qw") sM
285 # 9  <$> method_named(PV "unimport") 
286 # a  <1> entersub[t1] KS*/TARG,2
287 # b  <1> leavesub[1 ref] K/REFC,1
288 EONT_EONT