This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
B:: changes for UNITCHECK blocks
[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 => 8;
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, $uc) = qq{'foo'}; BEGIN { $beg++ } CHECK { $chk++ } INIT { $init++ } END { $end++ } UNITCHECK {$uc++}];
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 checkOptree ( name      => 'UNITCHECK',
156               bcopts    => 'UNITCHECK',
157               prog      => $src,
158               @open_todo,
159               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
160 # UNITCHECK 1:
161 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
162 # -     <@> lineseq KP ->4
163 # 1        <;> nextstate(main 3 -e:4) v:{ ->2
164 # 3        <1> postinc[t3] sK/1 ->4
165 # -           <1> ex-rv2sv sKRM/1 ->3
166 # 2              <#> gvsv[*uc] s ->3
167 EOT_EOT
168 # UNITCHECK 1:
169 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
170 # -     <@> lineseq KP ->4
171 # 1        <;> nextstate(main 3 -e:4) v:{ ->2
172 # 3        <1> postinc[t2] sK/1 ->4
173 # -           <1> ex-rv2sv sKRM/1 ->3
174 # 2              <$> gvsv(*uc) s ->3
175 EONT_EONT
176
177
178 checkOptree ( name      => 'INIT',
179               bcopts    => 'INIT',
180               #todo     => 'get working',
181               prog      => $src,
182               @open_todo,
183               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
184 # INIT 1:
185 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
186 # -     <@> lineseq KP ->4
187 # 1        <;> nextstate(main 4 -e:5) v:{ ->2
188 # 3        <1> postinc[t3] sK/1 ->4
189 # -           <1> ex-rv2sv sKRM/1 ->3
190 # 2              <#> gvsv[*init] s ->3
191 EOT_EOT
192 # INIT 1:
193 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
194 # -     <@> lineseq KP ->4
195 # 1        <;> nextstate(main 4 -e:5) v:{ ->2
196 # 3        <1> postinc[t2] sK/1 ->4
197 # -           <1> ex-rv2sv sKRM/1 ->3
198 # 2              <$> gvsv(*init) s ->3
199 EONT_EONT
200
201
202 checkOptree ( name      => 'all of BEGIN END INIT CHECK UNITCHECK -exec',
203               bcopts    => [qw/ BEGIN END INIT CHECK UNITCHECK -exec /],
204               prog      => $src,
205               @warnings_todo,
206               @open_todo,
207               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
208 # BEGIN 1:
209 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
210 # 2  <$> const[PV "warnings.pm"] s/BARE
211 # 3  <1> require sK/1
212 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
213 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
214 # 6  <0> pushmark s
215 # 7  <$> const[PV "warnings"] sM
216 # 8  <$> const[PV "qw"] sM
217 # 9  <$> method_named[PV "unimport"] 
218 # a  <1> entersub[t1] KS*/TARG,2
219 # b  <1> leavesub[1 ref] K/REFC,1
220 # BEGIN 2:
221 # c  <;> nextstate(main 2 -e:1) v:{
222 # d  <#> gvsv[*beg] s
223 # e  <1> postinc[t3] sK/1
224 # f  <1> leavesub[1 ref] K/REFC,1
225 # END 1:
226 # g  <;> nextstate(main 5 -e:1) v:{
227 # h  <#> gvsv[*end] s
228 # i  <1> postinc[t3] sK/1
229 # j  <1> leavesub[1 ref] K/REFC,1
230 # INIT 1:
231 # k  <;> nextstate(main 4 -e:1) v:{
232 # l  <#> gvsv[*init] s
233 # m  <1> postinc[t3] sK/1
234 # n  <1> leavesub[1 ref] K/REFC,1
235 # CHECK 1:
236 # o  <;> nextstate(main 3 -e:1) v:{
237 # p  <#> gvsv[*chk] s
238 # q  <1> postinc[t3] sK/1
239 # r  <1> leavesub[1 ref] K/REFC,1
240 # UNITCHECK 1:
241 # s  <;> nextstate(main 6 -e:1) v:{
242 # t  <#> gvsv[*uc] s
243 # u  <1> postinc[t3] sK/1
244 # v  <1> leavesub[1 ref] K/REFC,1
245 EOT_EOT
246 # BEGIN 1:
247 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
248 # 2  <$> const(PV "warnings.pm") s/BARE
249 # 3  <1> require sK/1
250 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
251 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
252 # 6  <0> pushmark s
253 # 7  <$> const(PV "warnings") sM
254 # 8  <$> const(PV "qw") sM
255 # 9  <$> method_named(PV "unimport") 
256 # a  <1> entersub[t1] KS*/TARG,2
257 # b  <1> leavesub[1 ref] K/REFC,1
258 # BEGIN 2:
259 # c  <;> nextstate(main 2 -e:1) v:{
260 # d  <$> gvsv(*beg) s
261 # e  <1> postinc[t2] sK/1
262 # f  <1> leavesub[1 ref] K/REFC,1
263 # END 1:
264 # g  <;> nextstate(main 5 -e:1) v:{
265 # h  <$> gvsv(*end) s
266 # i  <1> postinc[t2] sK/1
267 # j  <1> leavesub[1 ref] K/REFC,1
268 # INIT 1:
269 # k  <;> nextstate(main 4 -e:1) v:{
270 # l  <$> gvsv(*init) s
271 # m  <1> postinc[t2] sK/1
272 # n  <1> leavesub[1 ref] K/REFC,1
273 # CHECK 1:
274 # o  <;> nextstate(main 3 -e:1) v:{
275 # p  <$> gvsv(*chk) s
276 # q  <1> postinc[t2] sK/1
277 # r  <1> leavesub[1 ref] K/REFC,1
278 # UNITCHECK 1:
279 # s  <;> nextstate(main 6 -e:1) v:{
280 # t  <$> gvsv(*uc) s
281 # u  <1> postinc[t2] sK/1
282 # v  <1> leavesub[1 ref] K/REFC,1
283 EONT_EONT
284
285
286 # perl "-I../lib" -MO=Concise,BEGIN,CHECK,INIT,END,-exec -e '$a=$b && print q/foo/'
287
288
289
290 checkOptree ( name      => 'regression test for patch 25352',
291               bcopts    => [qw/ BEGIN END INIT CHECK -exec /],
292               prog      => 'print q/foo/',
293               @warnings_todo,
294               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
295 # BEGIN 1:
296 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
297 # 2  <$> const[PV "warnings.pm"] s/BARE
298 # 3  <1> require sK/1
299 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
300 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
301 # 6  <0> pushmark s
302 # 7  <$> const[PV "warnings"] sM
303 # 8  <$> const[PV "qw"] sM
304 # 9  <$> method_named[PV "unimport"] 
305 # a  <1> entersub[t1] KS*/TARG,2
306 # b  <1> leavesub[1 ref] K/REFC,1
307 EOT_EOT
308 # BEGIN 1:
309 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
310 # 2  <$> const(PV "warnings.pm") s/BARE
311 # 3  <1> require sK/1
312 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
313 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
314 # 6  <0> pushmark s
315 # 7  <$> const(PV "warnings") sM
316 # 8  <$> const(PV "qw") sM
317 # 9  <$> method_named(PV "unimport") 
318 # a  <1> entersub[t1] KS*/TARG,2
319 # b  <1> leavesub[1 ref] K/REFC,1
320 EONT_EONT