This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix ext/XS-APItest/t/*.t that assumed '.' in @INC
[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
9 BEGIN { push @INC, '.' } # t/BHK.pm is in ext/XS-APItest/ directory
10
11 use t::BHK ();      # make sure it gets compiled early
12
13 BEGIN { package XS::APItest; *main::bhkav = \@XS::APItest::bhkav }
14
15 # 'use t::BHK' switches on recording hooks, and clears @bhkav.
16 # 'no t::BHK' switches recording off again.
17 # 'use t::BHK push => "foo"' pushes onto @bhkav
18
19 use t::BHK;
20     1;
21 no t::BHK;
22
23 BEGIN { is_deeply \@bhkav, [], "no blocks" }
24
25 use t::BHK;
26     {
27         1;
28     }
29 no t::BHK;
30
31 BEGIN { is_deeply \@bhkav, 
32     [[start => 1], qw/pre_end post_end/], 
33     "plain block";
34 }
35
36 use t::BHK;
37     if (1) { 1 }
38 no t::BHK;
39
40 BEGIN { 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 }
49
50 use t::BHK;
51     for (1) { 1 }
52 no t::BHK;
53
54 BEGIN { 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
64 use t::BHK;
65     {
66         { 1; }
67     }
68 no t::BHK;
69
70 BEGIN { 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 }
79
80 use t::BHK;
81     use t::BHK push => "before";
82     {
83         use t::BHK push => "inside";
84     }
85     use t::BHK push => "after";
86 no t::BHK;
87
88 BEGIN { 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 }
98
99 use t::BHK;
100     BEGIN { 1 }
101 no t::BHK;
102
103 BEGIN { is_deeply \@bhkav,
104     [
105         [start => 1],
106         qw/pre_end post_end/,
107     ],
108     "BEGIN block";
109 }
110
111 use t::BHK; t::BHK->import;
112     eval "1";
113 no t::BHK; t::BHK->unimport;
114
115 BEGIN { is_deeply \@bhkav, [], "string eval (compile)" }
116 is_deeply \@bhkav, 
117     [
118         [eval => "entereval"],
119         [start => 1],
120         qw/pre_end post_end/,
121     ], 
122     "string eval (run)";
123
124 delete @INC{qw{t/Null.pm t/Block.pm}};
125
126 t::BHK->import;
127     do "t/Null.pm";
128 t::BHK->unimport;
129
130 is_deeply \@bhkav,
131     [
132         [eval => "dofile"],
133         [start => 1],
134         qw/pre_end post_end/,
135     ],
136     "do file (null)";
137
138 t::BHK->import;
139     do "t/Block.pm";
140 t::BHK->unimport;
141
142 is_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
152 delete @INC{qw{t/Null.pm t/Block.pm}};
153
154 t::BHK->import;
155     require t::Null;
156 t::BHK->unimport;
157
158 is_deeply \@bhkav,
159     [
160         [eval => "require"],
161         [start => 1],
162         qw/pre_end post_end/,
163     ],
164     "require (null)";
165
166 t::BHK->import;
167     require t::Block;
168 t::BHK->unimport;
169
170 is_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
180 BEGIN { delete $INC{"t/Block.pm"} }
181
182 use t::BHK;
183     use t::Block;
184 no t::BHK;
185
186 BEGIN { 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)";
195 }
196
197 BEGIN { delete $INC{"t/Markers.pm"} }
198
199 use t::BHK;
200     use t::BHK push => "compile/main/before";
201     use t::Markers;
202     use t::BHK push => "compile/main/after";
203 no t::BHK;
204
205 BEGIN { 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 }
222
223 # OK, now some *really* evil stuff...
224
225 BEGIN {
226     package EvalDestroy;
227
228     sub DESTROY { $_[0]->() }
229 }
230
231 use 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;
241     }
242 no t::BHK;
243
244 BEGIN { 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";
256 }
257
258 use t::BHK;
259     {
260         BEGIN { 
261             push @XS::APItest::COMPILE_SCOPE_CONTAINER, 
262                 bless sub {
263                     eval "{1}";
264                 }, "EvalDestroy";
265         }
266         1;
267     }
268 no t::BHK;
269
270 BEGIN { 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 }