This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Systematic tests for the block hooks.
[perl5.git] / ext / XS-APItest / t / blockhooks.t
CommitLineData
13b6b3bc 1#!/usr/bin/perl
03569ecf 2
03569ecf 3use warnings;
13b6b3bc
BM
4use strict;
5use Test::More tests => 17;
6
03569ecf 7use XS::APItest;
13b6b3bc 8use t::BHK (); # make sure it gets compiled early
03569ecf 9
13b6b3bc 10BEGIN { package XS::APItest; *main::bhkav = \@XS::APItest::bhkav }
03569ecf 11
13b6b3bc
BM
12# 'use t::BHK' switches on recording hooks, and clears @bhkav.
13# 'no t::BHK' switches recording off again.
14# 'use t::BHK push => "foo"' pushes onto @bhkav
03569ecf 15
13b6b3bc
BM
16BEGIN { diag "## COMPILE TIME ##" }
17diag "## RUN TIME ##";
03569ecf 18
13b6b3bc
BM
19use t::BHK;
20 1;
21no t::BHK;
03569ecf 22
13b6b3bc 23BEGIN { is_deeply \@bhkav, [], "no blocks" }
03569ecf 24
13b6b3bc
BM
25use t::BHK;
26 {
27 1;
03569ecf 28 }
13b6b3bc 29no t::BHK;
03569ecf 30
13b6b3bc
BM
31BEGIN { is_deeply \@bhkav,
32 [[start => 1], qw/pre_end post_end/],
33 "plain block";
34}
35
36use t::BHK;
37 if (1) { 1 }
38no t::BHK;
03569ecf 39
13b6b3bc
BM
40BEGIN { is_deeply \@bhkav,
41 [
42 [start => 1],
43 [start => 0],
44 qw/pre_end post_end/,
45 qw/pre_end post_end/,
46 ],
47 "if block";
48}
03569ecf 49
13b6b3bc
BM
50use t::BHK;
51 for (1) { 1 }
52no t::BHK;
53
54BEGIN { is_deeply \@bhkav,
55 [
56 [start => 1],
57 [start => 0],
58 qw/pre_end post_end/,
59 qw/pre_end post_end/,
60 ],
61 "for loop";
62}
63
64use t::BHK;
65 {
66 { 1; }
03569ecf 67 }
13b6b3bc 68no t::BHK;
03569ecf 69
13b6b3bc
BM
70BEGIN { is_deeply \@bhkav,
71 [
72 [start => 1],
73 [start => 1],
74 qw/pre_end post_end/,
75 qw/pre_end post_end/,
76 ],
77 "nested blocks";
78}
03569ecf 79
13b6b3bc
BM
80use t::BHK;
81 use t::BHK push => "before";
82 {
83 use t::BHK push => "inside";
03569ecf 84 }
13b6b3bc
BM
85 use t::BHK push => "after";
86no t::BHK;
03569ecf 87
13b6b3bc
BM
88BEGIN { is_deeply \@bhkav,
89 [
90 "before",
91 [start => 1],
92 "inside",
93 qw/pre_end post_end/,
94 "after"
95 ],
96 "hooks called in the correct places";
97}
03569ecf 98
13b6b3bc
BM
99use t::BHK;
100 BEGIN { 1 }
101no t::BHK;
03569ecf 102
13b6b3bc
BM
103BEGIN { is_deeply \@bhkav,
104 [
105 [start => 1],
106 qw/pre_end post_end/,
107 ],
108 "BEGIN block";
109}
03569ecf 110
13b6b3bc
BM
111use t::BHK; t::BHK->import;
112 eval "1";
113no t::BHK; t::BHK->unimport;
114
115BEGIN { is_deeply \@bhkav, [], "string eval (compile)" }
116is_deeply \@bhkav,
117 [
118 [eval => "entereval"],
119 [start => 1],
120 qw/pre_end post_end/,
121 ],
122 "string eval (run)";
123
124delete @INC{qw{t/Null.pm t/Block.pm}};
125
126t::BHK->import;
127 do "t/Null.pm";
128t::BHK->unimport;
129
130is_deeply \@bhkav,
131 [
132 [eval => "dofile"],
133 [start => 1],
134 qw/pre_end post_end/,
135 ],
136 "do file (null)";
137
138t::BHK->import;
139 do "t/Block.pm";
140t::BHK->unimport;
141
142is_deeply \@bhkav,
143 [
144 [eval => "dofile"],
145 [start => 1],
146 [start => 1],
147 qw/pre_end post_end/,
148 qw/pre_end post_end/,
149 ],
150 "do file (single block)";
151
152delete @INC{qw{t/Null.pm t/Block.pm}};
153
154t::BHK->import;
155 require t::Null;
156t::BHK->unimport;
157
158is_deeply \@bhkav,
159 [
160 [eval => "require"],
161 [start => 1],
162 qw/pre_end post_end/,
163 ],
164 "require (null)";
165
166t::BHK->import;
167 require t::Block;
168t::BHK->unimport;
169
170is_deeply \@bhkav,
171 [
172 [eval => "require"],
173 [start => 1],
174 [start => 1],
175 qw/pre_end post_end/,
176 qw/pre_end post_end/,
177 ],
178 "require (single block)";
179
180BEGIN { delete $INC{"t/Block.pm"} }
181
182use t::BHK;
183 use t::Block;
184no t::BHK;
185
186BEGIN { is_deeply \@bhkav,
187 [
188 [eval => "require"],
189 [start => 1],
190 [start => 1],
191 qw/pre_end post_end/,
192 qw/pre_end post_end/,
193 ],
194 "use (single block)";
03569ecf
BM
195}
196
13b6b3bc 197BEGIN { delete $INC{"t/Markers.pm"} }
03569ecf 198
13b6b3bc
BM
199use t::BHK;
200 use t::BHK push => "compile/main/before";
201 use t::Markers;
202 use t::BHK push => "compile/main/after";
203no t::BHK;
03569ecf 204
13b6b3bc
BM
205BEGIN { is_deeply \@bhkav,
206 [
207 "compile/main/before",
208 [eval => "require"],
209 [start => 1],
210 "compile/pm/before",
211 [start => 1],
212 "compile/pm/inside",
213 qw/pre_end post_end/,
214 "compile/pm/after",
215 qw/pre_end post_end/,
216 "run/pm",
217 "run/import",
218 "compile/main/after",
219 ],
220 "use with markers";
221}
03569ecf 222
13b6b3bc 223# OK, now some *really* evil stuff...
03569ecf 224
13b6b3bc
BM
225BEGIN {
226 package EvalDestroy;
03569ecf 227
13b6b3bc
BM
228 sub DESTROY { $_[0]->() }
229}
03569ecf 230
13b6b3bc
BM
231use t::BHK;
232 {
233 BEGIN {
234 # grumbleSCOPECHECKgrumble
235 push @XS::APItest::COMPILE_SCOPE_CONTAINER,
236 bless sub {
237 push @bhkav, "DESTROY";
238 }, "EvalDestroy";
239 }
240 1;
03569ecf 241 }
13b6b3bc 242no t::BHK;
03569ecf 243
13b6b3bc
BM
244BEGIN { is_deeply \@bhkav,
245 [
246 [start => 1], # block
247 [start => 1], # BEGIN
248 [start => 1], # sub
249 qw/pre_end post_end/,
250 qw/pre_end post_end/,
251 "pre_end",
252 "DESTROY",
253 "post_end",
254 ],
255 "compile-time DESTROY comes between pre_ and post_end";
03569ecf
BM
256}
257
13b6b3bc
BM
258use t::BHK;
259 {
260 BEGIN {
261 push @XS::APItest::COMPILE_SCOPE_CONTAINER,
262 bless sub {
263 eval "{1}";
264 }, "EvalDestroy";
265 }
266 1;
267 }
268no t::BHK;
269
270BEGIN { is_deeply \@bhkav,
271 [
272 [start => 1], # block
273 [start => 1], # BEGIN
274 [start => 1], # sub
275 qw/pre_end post_end/,
276 qw/pre_end post_end/,
277 "pre_end",
278 [eval => "entereval"],
279 [start => 1], # eval
280 [start => 1], # block inside eval
281 qw/pre_end post_end/,
282 qw/pre_end post_end/,
283 "post_end",
284 ],
285 "evil eval-in-DESTROY tricks";
286}