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