line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test2::API; |
2
|
54
|
|
|
54
|
|
15200
|
use strict; |
|
54
|
|
|
|
|
58
|
|
|
54
|
|
|
|
|
1188
|
|
3
|
54
|
|
|
54
|
|
143
|
use warnings; |
|
54
|
|
|
|
|
56
|
|
|
54
|
|
|
|
|
2553
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.000042'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
my $INST; |
8
|
|
|
|
|
|
|
my $ENDING = 0; |
9
|
166
|
|
|
166
|
|
1164
|
sub _set_is_end { $ENDING = 1 } |
10
|
|
|
|
|
|
|
|
11
|
54
|
|
|
54
|
|
12445
|
use Test2::API::Instance(\$INST); |
|
54
|
|
|
|
|
73
|
|
|
54
|
|
|
|
|
758
|
|
12
|
|
|
|
|
|
|
# Set the exit status |
13
|
|
|
|
|
|
|
END { |
14
|
54
|
|
|
54
|
|
305
|
_set_is_end(); # See gh #16 |
15
|
54
|
|
|
|
|
245
|
$INST->set_exit(); |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# See gh #16 |
19
|
|
|
|
|
|
|
{ |
20
|
54
|
|
|
54
|
|
658
|
no warnings; |
|
54
|
|
|
|
|
58
|
|
|
54
|
|
|
|
|
2860
|
|
21
|
53
|
50
|
|
53
|
|
76648
|
INIT { eval 'END { _set_is_end() }; 1' or die $@ } |
|
51
|
|
|
51
|
|
243
|
|
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
BEGIN { |
25
|
54
|
|
|
54
|
|
197
|
no warnings 'once'; |
|
54
|
|
|
|
|
54
|
|
|
54
|
|
|
|
|
3977
|
|
26
|
54
|
50
|
33
|
54
|
|
255
|
if($] ge '5.014' || $ENV{T2_CHECK_DEPTH} || $Test2::API::DO_DEPTH_CHECK) { |
|
|
|
0
|
|
|
|
|
27
|
54
|
|
|
|
|
705
|
*DO_DEPTH_CHECK = sub() { 1 }; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
else { |
30
|
0
|
|
|
|
|
0
|
*DO_DEPTH_CHECK = sub() { 0 }; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
54
|
|
|
54
|
|
193
|
use Test2::Util::Trace(); |
|
54
|
|
|
|
|
47
|
|
|
54
|
|
|
|
|
531
|
|
35
|
|
|
|
|
|
|
|
36
|
54
|
|
|
54
|
|
16794
|
use Test2::Hub::Subtest(); |
|
54
|
|
|
|
|
71
|
|
|
54
|
|
|
|
|
804
|
|
37
|
54
|
|
|
54
|
|
16514
|
use Test2::Hub::Interceptor(); |
|
54
|
|
|
|
|
81
|
|
|
54
|
|
|
|
|
730
|
|
38
|
54
|
|
|
54
|
|
209
|
use Test2::Hub::Interceptor::Terminator(); |
|
54
|
|
|
|
|
51
|
|
|
54
|
|
|
|
|
577
|
|
39
|
|
|
|
|
|
|
|
40
|
54
|
|
|
54
|
|
15863
|
use Test2::Event::Ok(); |
|
54
|
|
|
|
|
73
|
|
|
54
|
|
|
|
|
729
|
|
41
|
54
|
|
|
54
|
|
15912
|
use Test2::Event::Diag(); |
|
54
|
|
|
|
|
80
|
|
|
54
|
|
|
|
|
718
|
|
42
|
54
|
|
|
54
|
|
15957
|
use Test2::Event::Note(); |
|
54
|
|
|
|
|
81
|
|
|
54
|
|
|
|
|
695
|
|
43
|
54
|
|
|
54
|
|
15760
|
use Test2::Event::Plan(); |
|
54
|
|
|
|
|
70
|
|
|
54
|
|
|
|
|
764
|
|
44
|
54
|
|
|
54
|
|
16174
|
use Test2::Event::Bail(); |
|
54
|
|
|
|
|
90
|
|
|
54
|
|
|
|
|
698
|
|
45
|
54
|
|
|
54
|
|
15536
|
use Test2::Event::Exception(); |
|
54
|
|
|
|
|
78
|
|
|
54
|
|
|
|
|
752
|
|
46
|
54
|
|
|
54
|
|
15254
|
use Test2::Event::Waiting(); |
|
54
|
|
|
|
|
114
|
|
|
54
|
|
|
|
|
692
|
|
47
|
54
|
|
|
54
|
|
14940
|
use Test2::Event::Skip(); |
|
54
|
|
|
|
|
86
|
|
|
54
|
|
|
|
|
692
|
|
48
|
54
|
|
|
54
|
|
15701
|
use Test2::Event::Subtest(); |
|
54
|
|
|
|
|
86
|
|
|
54
|
|
|
|
|
1013
|
|
49
|
|
|
|
|
|
|
|
50
|
54
|
|
|
54
|
|
190
|
use Carp qw/carp croak confess longmess/; |
|
54
|
|
|
|
|
44
|
|
|
54
|
|
|
|
|
2514
|
|
51
|
54
|
|
|
54
|
|
175
|
use Scalar::Util qw/blessed weaken/; |
|
54
|
|
|
|
|
49
|
|
|
54
|
|
|
|
|
1904
|
|
52
|
54
|
|
|
54
|
|
164
|
use Test2::Util qw/get_tid/; |
|
54
|
|
|
|
|
52
|
|
|
54
|
|
|
|
|
3441
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
our @EXPORT_OK = qw{ |
55
|
|
|
|
|
|
|
context release |
56
|
|
|
|
|
|
|
context_do |
57
|
|
|
|
|
|
|
no_context |
58
|
|
|
|
|
|
|
intercept |
59
|
|
|
|
|
|
|
run_subtest |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
test2_init_done |
62
|
|
|
|
|
|
|
test2_load_done |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
test2_pid |
65
|
|
|
|
|
|
|
test2_tid |
66
|
|
|
|
|
|
|
test2_stack |
67
|
|
|
|
|
|
|
test2_no_wait |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
test2_add_callback_context_aquire |
70
|
|
|
|
|
|
|
test2_add_callback_context_acquire |
71
|
|
|
|
|
|
|
test2_add_callback_context_init |
72
|
|
|
|
|
|
|
test2_add_callback_context_release |
73
|
|
|
|
|
|
|
test2_add_callback_exit |
74
|
|
|
|
|
|
|
test2_add_callback_post_load |
75
|
|
|
|
|
|
|
test2_list_context_aquire_callbacks |
76
|
|
|
|
|
|
|
test2_list_context_acquire_callbacks |
77
|
|
|
|
|
|
|
test2_list_context_init_callbacks |
78
|
|
|
|
|
|
|
test2_list_context_release_callbacks |
79
|
|
|
|
|
|
|
test2_list_exit_callbacks |
80
|
|
|
|
|
|
|
test2_list_post_load_callbacks |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
test2_ipc |
83
|
|
|
|
|
|
|
test2_ipc_drivers |
84
|
|
|
|
|
|
|
test2_ipc_add_driver |
85
|
|
|
|
|
|
|
test2_ipc_polling |
86
|
|
|
|
|
|
|
test2_ipc_disable_polling |
87
|
|
|
|
|
|
|
test2_ipc_enable_polling |
88
|
|
|
|
|
|
|
test2_ipc_get_pending |
89
|
|
|
|
|
|
|
test2_ipc_set_pending |
90
|
|
|
|
|
|
|
test2_ipc_enable_shm |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
test2_formatter |
93
|
|
|
|
|
|
|
test2_formatters |
94
|
|
|
|
|
|
|
test2_formatter_add |
95
|
|
|
|
|
|
|
test2_formatter_set |
96
|
|
|
|
|
|
|
}; |
97
|
54
|
|
|
54
|
|
1681
|
use base 'Exporter'; |
|
54
|
|
|
|
|
70
|
|
|
54
|
|
|
|
|
3889
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# There is a use-cycle between API and API/Context. Context needs to use some |
100
|
|
|
|
|
|
|
# API functions as the package is compiling. Test2::API::context() needs |
101
|
|
|
|
|
|
|
# Test2::API::Context to be loaded, but we cannot 'require' the module there as |
102
|
|
|
|
|
|
|
# it causes a very noticable performance impact with how often context() is |
103
|
|
|
|
|
|
|
# called. |
104
|
|
|
|
|
|
|
# |
105
|
|
|
|
|
|
|
# This will make sure that Context.pm is loaded the first time this module is |
106
|
|
|
|
|
|
|
# imported, then the regular import method is swapped into place. |
107
|
|
|
|
|
|
|
sub import { |
108
|
|
|
|
|
|
|
require Test2::API::Context unless $INC{'Test2/API/Context.pm'}; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
{ |
111
|
54
|
|
|
54
|
|
201
|
no warnings 'redefine'; |
|
54
|
|
|
|
|
44
|
|
|
54
|
|
|
|
|
96452
|
|
112
|
|
|
|
|
|
|
*import = \&Exporter::import; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
goto &import; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
my $STACK = $INST->stack; |
119
|
|
|
|
|
|
|
my $CONTEXTS = $INST->contexts; |
120
|
|
|
|
|
|
|
my $INIT_CBS = $INST->context_init_callbacks; |
121
|
|
|
|
|
|
|
my $ACQUIRE_CBS = $INST->context_acquire_callbacks; |
122
|
|
|
|
|
|
|
|
123
|
22
|
|
|
22
|
1
|
60
|
sub test2_init_done { $INST->finalized } |
124
|
3
|
|
|
3
|
1
|
9
|
sub test2_load_done { $INST->loaded } |
125
|
|
|
|
|
|
|
|
126
|
1
|
|
|
1
|
0
|
4
|
sub test2_pid { $INST->pid } |
127
|
1
|
|
|
1
|
0
|
3
|
sub test2_tid { $INST->tid } |
128
|
41
|
|
|
41
|
1
|
2616
|
sub test2_stack { $INST->stack } |
129
|
|
|
|
|
|
|
sub test2_no_wait { |
130
|
5
|
100
|
|
5
|
1
|
21
|
$INST->set_no_wait(@_) if @_; |
131
|
5
|
|
|
|
|
8
|
$INST->no_wait; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
3
|
|
|
3
|
1
|
22
|
sub test2_add_callback_context_acquire { $INST->add_context_acquire_callback(@_) } |
135
|
0
|
|
|
0
|
0
|
0
|
sub test2_add_callback_context_aquire { $INST->add_context_acquire_callback(@_) } |
136
|
3
|
|
|
3
|
1
|
13
|
sub test2_add_callback_context_init { $INST->add_context_init_callback(@_) } |
137
|
4
|
|
|
4
|
1
|
22
|
sub test2_add_callback_context_release { $INST->add_context_release_callback(@_) } |
138
|
3
|
|
|
3
|
1
|
9
|
sub test2_add_callback_exit { $INST->add_exit_callback(@_) } |
139
|
3
|
|
|
3
|
1
|
9
|
sub test2_add_callback_post_load { $INST->add_post_load_callback(@_) } |
140
|
0
|
|
|
0
|
0
|
0
|
sub test2_list_context_aquire_callbacks { @{$INST->context_acquire_callbacks} } |
|
0
|
|
|
|
|
0
|
|
141
|
2
|
|
|
2
|
1
|
6
|
sub test2_list_context_acquire_callbacks { @{$INST->context_acquire_callbacks} } |
|
2
|
|
|
|
|
6
|
|
142
|
2
|
|
|
2
|
1
|
5
|
sub test2_list_context_init_callbacks { @{$INST->context_init_callbacks} } |
|
2
|
|
|
|
|
5
|
|
143
|
2
|
|
|
2
|
1
|
5
|
sub test2_list_context_release_callbacks { @{$INST->context_release_callbacks} } |
|
2
|
|
|
|
|
6
|
|
144
|
2
|
|
|
2
|
1
|
7
|
sub test2_list_exit_callbacks { @{$INST->exit_callbacks} } |
|
2
|
|
|
|
|
5
|
|
145
|
2
|
|
|
2
|
1
|
6
|
sub test2_list_post_load_callbacks { @{$INST->post_load_callbacks} } |
|
2
|
|
|
|
|
6
|
|
146
|
|
|
|
|
|
|
|
147
|
91
|
|
|
91
|
1
|
284
|
sub test2_ipc { $INST->ipc } |
148
|
2
|
|
|
2
|
1
|
19
|
sub test2_ipc_add_driver { $INST->add_ipc_driver(@_) } |
149
|
6
|
|
|
6
|
1
|
20
|
sub test2_ipc_drivers { @{$INST->ipc_drivers} } |
|
6
|
|
|
|
|
18
|
|
150
|
3
|
|
|
3
|
1
|
8
|
sub test2_ipc_polling { $INST->ipc_polling } |
151
|
1
|
|
|
1
|
1
|
2
|
sub test2_ipc_enable_polling { $INST->enable_ipc_polling } |
152
|
1
|
|
|
1
|
1
|
3
|
sub test2_ipc_disable_polling { $INST->disable_ipc_polling } |
153
|
0
|
|
|
0
|
1
|
0
|
sub test2_ipc_get_pending { $INST->get_ipc_pending } |
154
|
32
|
|
|
32
|
1
|
181
|
sub test2_ipc_set_pending { $INST->set_ipc_pending(@_) } |
155
|
0
|
|
|
0
|
1
|
0
|
sub test2_ipc_enable_shm { $INST->ipc_enable_shm } |
156
|
|
|
|
|
|
|
|
157
|
76
|
|
|
76
|
1
|
220
|
sub test2_formatter { $INST->formatter } |
158
|
0
|
|
|
0
|
1
|
0
|
sub test2_formatters { @{$INST->formatters} } |
|
0
|
|
|
|
|
0
|
|
159
|
1
|
|
|
1
|
1
|
3
|
sub test2_formatter_add { $INST->add_formatter(@_) } |
160
|
|
|
|
|
|
|
sub test2_formatter_set { |
161
|
2
|
|
|
2
|
1
|
27
|
my ($formatter) = @_; |
162
|
2
|
100
|
|
|
|
77
|
croak "No formatter specified" unless $formatter; |
163
|
1
|
50
|
|
|
|
4
|
croak "Global Formatter already set" if $INST->formatter_set; |
164
|
0
|
|
|
|
|
0
|
$INST->set_formatter($formatter); |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# Private, for use in Test2::API::Context |
168
|
54
|
|
|
54
|
|
115
|
sub _contexts_ref { $INST->contexts } |
169
|
1
|
|
|
1
|
|
4
|
sub _context_acquire_callbacks_ref { $INST->context_acquire_callbacks } |
170
|
1
|
|
|
1
|
|
5
|
sub _context_init_callbacks_ref { $INST->context_init_callbacks } |
171
|
55
|
|
|
55
|
|
178
|
sub _context_release_callbacks_ref { $INST->context_release_callbacks } |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# Private, for use in Test2::IPC |
174
|
0
|
|
|
0
|
|
0
|
sub _set_ipc { $INST->set_ipc(@_) } |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub context_do(&;@) { |
177
|
4
|
|
|
4
|
1
|
20
|
my $code = shift; |
178
|
4
|
|
|
|
|
5
|
my @args = @_; |
179
|
|
|
|
|
|
|
|
180
|
4
|
|
|
|
|
6
|
my $ctx = context(level => 1); |
181
|
|
|
|
|
|
|
|
182
|
4
|
|
|
|
|
7
|
my $want = wantarray; |
183
|
|
|
|
|
|
|
|
184
|
4
|
|
|
|
|
3
|
my @out; |
185
|
4
|
|
|
|
|
5
|
my $ok = eval { |
186
|
4
|
100
|
|
|
|
15
|
$want ? @out = $code->($ctx, @args) : |
|
|
100
|
|
|
|
|
|
187
|
|
|
|
|
|
|
defined($want) ? $out[0] = $code->($ctx, @args) : |
188
|
|
|
|
|
|
|
$code->($ctx, @args) ; |
189
|
3
|
|
|
|
|
13
|
1; |
190
|
|
|
|
|
|
|
}; |
191
|
4
|
|
|
|
|
12
|
my $err = $@; |
192
|
|
|
|
|
|
|
|
193
|
4
|
|
|
|
|
8
|
$ctx->release; |
194
|
|
|
|
|
|
|
|
195
|
4
|
100
|
|
|
|
10
|
die $err unless $ok; |
196
|
|
|
|
|
|
|
|
197
|
3
|
100
|
|
|
|
7
|
return @out if $want; |
198
|
2
|
100
|
|
|
|
5
|
return $out[0] if defined $want; |
199
|
1
|
|
|
|
|
2
|
return; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub no_context(&;$) { |
203
|
3
|
|
|
3
|
1
|
4
|
my ($code, $hid) = @_; |
204
|
3
|
|
66
|
|
|
7
|
$hid ||= $STACK->top->hid; |
205
|
|
|
|
|
|
|
|
206
|
3
|
|
|
|
|
10
|
my $ctx = $CONTEXTS->{$hid}; |
207
|
3
|
|
|
|
|
4
|
delete $CONTEXTS->{$hid}; |
208
|
3
|
|
|
|
|
3
|
my $ok = eval { $code->(); 1 }; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
5
|
|
209
|
3
|
|
|
|
|
3
|
my $err = $@; |
210
|
|
|
|
|
|
|
|
211
|
3
|
|
|
|
|
5
|
$CONTEXTS->{$hid} = $ctx; |
212
|
3
|
|
|
|
|
4
|
weaken($CONTEXTS->{$hid}); |
213
|
|
|
|
|
|
|
|
214
|
3
|
50
|
|
|
|
6
|
die $err unless $ok; |
215
|
|
|
|
|
|
|
|
216
|
3
|
|
|
|
|
4
|
return; |
217
|
|
|
|
|
|
|
}; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub context { |
220
|
|
|
|
|
|
|
# We need to grab these before anything else to ensure they are not |
221
|
|
|
|
|
|
|
# changed. |
222
|
1173
|
|
|
1173
|
1
|
3734965
|
my ($errno, $eval_error, $child_error) = (0 + $!, $@, $?); |
223
|
|
|
|
|
|
|
|
224
|
1173
|
|
|
|
|
2407
|
my %params = (level => 0, wrapped => 0, @_); |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# If something is getting a context then the sync system needs to be |
227
|
|
|
|
|
|
|
# considered loaded... |
228
|
1173
|
100
|
|
|
|
2650
|
$INST->load unless $INST->{loaded}; |
229
|
|
|
|
|
|
|
|
230
|
1173
|
100
|
|
|
|
1947
|
croak "context() called, but return value is ignored" |
231
|
|
|
|
|
|
|
unless defined wantarray; |
232
|
|
|
|
|
|
|
|
233
|
1172
|
|
33
|
|
|
3481
|
my $stack = $params{stack} || $STACK; |
234
|
1172
|
100
|
100
|
|
|
3939
|
my $hub = $params{hub} || @$stack ? $stack->[-1] : $stack->top; |
235
|
1172
|
|
|
|
|
1221
|
my $hid = $hub->{hid}; |
236
|
1172
|
|
|
|
|
1040
|
my $current = $CONTEXTS->{$hid}; |
237
|
|
|
|
|
|
|
|
238
|
1172
|
|
|
|
|
1938
|
$_->(\%params) for @$ACQUIRE_CBS; |
239
|
1172
|
100
|
|
|
|
1709
|
map $_->(\%params), @{$hub->{_context_acquire}} if $hub->{_context_acquire}; |
|
72
|
|
|
|
|
88
|
|
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# This is for https://github.com/Test-More/Test2/issues/16 |
242
|
|
|
|
|
|
|
# and https://rt.perl.org/Public/Bug/Display.html?id=127774 |
243
|
1172
|
|
50
|
|
|
2615
|
my $phase = ${^GLOBAL_PHASE} || 'NA'; |
244
|
1172
|
|
66
|
|
|
4808
|
my $end_phase = $ENDING || $phase eq 'END' || $phase eq 'DESTRUCT'; |
245
|
|
|
|
|
|
|
|
246
|
1172
|
|
|
|
|
1063
|
my $level = 1 + $params{level}; |
247
|
1172
|
100
|
|
|
|
5816
|
my ($pkg, $file, $line, $sub) = $end_phase ? caller(0) : caller($level); |
248
|
1172
|
100
|
66
|
|
|
2477
|
unless ($pkg || $end_phase) { |
249
|
2
|
100
|
|
|
|
145
|
confess "Could not find context at depth $level" unless $params{fudge}; |
250
|
1
|
|
66
|
|
|
40
|
($pkg, $file, $line, $sub) = caller(--$level) while ($level >= 0 && !$pkg); |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
1171
|
|
|
|
|
910
|
my $depth = $level; |
254
|
1171
|
|
100
|
|
|
9351
|
$depth++ while DO_DEPTH_CHECK && !$end_phase && (!$current || $depth <= $current->{_depth} + $params{wrapped}) && caller($depth + 1); |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
255
|
1171
|
|
|
|
|
1160
|
$depth -= $params{wrapped}; |
256
|
1171
|
|
100
|
|
|
3548
|
my $depth_ok = !DO_DEPTH_CHECK || $end_phase || !$current || $current->{_depth} < $depth; |
257
|
|
|
|
|
|
|
|
258
|
1171
|
100
|
66
|
|
|
1685
|
if ($current && $params{on_release} && $depth_ok) { |
|
|
|
66
|
|
|
|
|
259
|
1
|
|
50
|
|
|
3
|
$current->{_on_release} ||= []; |
260
|
1
|
|
|
|
|
1
|
push @{$current->{_on_release}} => $params{on_release}; |
|
1
|
|
|
|
|
1
|
|
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# I know this is ugly.... |
264
|
1171
|
100
|
50
|
|
|
2640
|
($!, $@, $?) = ($errno, $eval_error, $child_error) and return bless( |
|
|
|
100
|
|
|
|
|
265
|
|
|
|
|
|
|
{ |
266
|
|
|
|
|
|
|
%$current, |
267
|
|
|
|
|
|
|
_is_canon => undef, |
268
|
|
|
|
|
|
|
errno => $errno, |
269
|
|
|
|
|
|
|
eval_error => $eval_error, |
270
|
|
|
|
|
|
|
child_error => $child_error, |
271
|
|
|
|
|
|
|
_is_spawn => [$pkg, $file, $line, $sub], |
272
|
|
|
|
|
|
|
}, |
273
|
|
|
|
|
|
|
'Test2::API::Context' |
274
|
|
|
|
|
|
|
) if $current && $depth_ok; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# Handle error condition of bad level |
277
|
1082
|
100
|
|
|
|
1394
|
if ($current) { |
278
|
2
|
50
|
|
|
|
2
|
unless (${$current->{_aborted}}) { |
|
2
|
|
|
|
|
12
|
|
279
|
|
|
|
|
|
|
_canon_error($current, [$pkg, $file, $line, $sub, $depth]) |
280
|
2
|
50
|
|
|
|
5
|
unless $current->{_is_canon}; |
281
|
|
|
|
|
|
|
|
282
|
2
|
50
|
|
|
|
7
|
_depth_error($current, [$pkg, $file, $line, $sub, $depth]) |
283
|
|
|
|
|
|
|
unless $depth_ok; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
2
|
50
|
|
|
|
19
|
$current->release if $current->{_is_canon}; |
287
|
|
|
|
|
|
|
|
288
|
2
|
|
|
|
|
2
|
delete $CONTEXTS->{$hid}; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# Directly bless the object here, calling new is a noticable performance |
292
|
|
|
|
|
|
|
# hit with how often this needs to be called. |
293
|
1082
|
|
|
|
|
4334
|
my $trace = bless( |
294
|
|
|
|
|
|
|
{ |
295
|
|
|
|
|
|
|
frame => [$pkg, $file, $line, $sub], |
296
|
|
|
|
|
|
|
pid => $$, |
297
|
|
|
|
|
|
|
tid => get_tid(), |
298
|
|
|
|
|
|
|
}, |
299
|
|
|
|
|
|
|
'Test2::Util::Trace' |
300
|
|
|
|
|
|
|
); |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
# Directly bless the object here, calling new is a noticable performance |
303
|
|
|
|
|
|
|
# hit with how often this needs to be called. |
304
|
1082
|
|
|
|
|
925
|
my $aborted = 0; |
305
|
|
|
|
|
|
|
$current = bless( |
306
|
|
|
|
|
|
|
{ |
307
|
|
|
|
|
|
|
_aborted => \$aborted, |
308
|
|
|
|
|
|
|
stack => $stack, |
309
|
|
|
|
|
|
|
hub => $hub, |
310
|
|
|
|
|
|
|
trace => $trace, |
311
|
|
|
|
|
|
|
_is_canon => 1, |
312
|
|
|
|
|
|
|
_depth => $depth, |
313
|
|
|
|
|
|
|
errno => $errno, |
314
|
|
|
|
|
|
|
eval_error => $eval_error, |
315
|
|
|
|
|
|
|
child_error => $child_error, |
316
|
1082
|
100
|
|
|
|
5571
|
$params{on_release} ? (_on_release => [$params{on_release}]) : (), |
317
|
|
|
|
|
|
|
}, |
318
|
|
|
|
|
|
|
'Test2::API::Context' |
319
|
|
|
|
|
|
|
); |
320
|
|
|
|
|
|
|
|
321
|
1082
|
|
|
|
|
1449
|
$CONTEXTS->{$hid} = $current; |
322
|
1082
|
|
|
|
|
2414
|
weaken($CONTEXTS->{$hid}); |
323
|
|
|
|
|
|
|
|
324
|
1082
|
|
|
|
|
2184
|
$_->($current) for @$INIT_CBS; |
325
|
1082
|
100
|
|
|
|
1774
|
map $_->($current), @{$hub->{_context_init}} if $hub->{_context_init}; |
|
37
|
|
|
|
|
42
|
|
326
|
|
|
|
|
|
|
|
327
|
1082
|
100
|
|
|
|
1551
|
$params{on_init}->($current) if $params{on_init}; |
328
|
|
|
|
|
|
|
|
329
|
1082
|
|
|
|
|
2152
|
($!, $@, $?) = ($errno, $eval_error, $child_error); |
330
|
|
|
|
|
|
|
|
331
|
1082
|
|
|
|
|
3083
|
return $current; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub _depth_error { |
335
|
2
|
|
|
2
|
|
6
|
_existing_error(@_, <<" EOT"); |
336
|
|
|
|
|
|
|
context() was called to retrieve an existing context, however the existing |
337
|
|
|
|
|
|
|
context was created in a stack frame at the same, or deeper level. This usually |
338
|
|
|
|
|
|
|
means that a tool failed to release the context when it was finished. |
339
|
|
|
|
|
|
|
EOT |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub _canon_error { |
343
|
0
|
|
|
0
|
|
0
|
_existing_error(@_, <<" EOT"); |
344
|
|
|
|
|
|
|
context() was called to retrieve an existing context, however the existing |
345
|
|
|
|
|
|
|
context has an invalid internal state (!_canon_count). This should not normally |
346
|
|
|
|
|
|
|
happen unless something is mucking about with internals... |
347
|
|
|
|
|
|
|
EOT |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
sub _existing_error { |
351
|
2
|
|
|
2
|
|
4
|
my ($ctx, $details, $msg) = @_; |
352
|
2
|
|
|
|
|
4
|
my ($pkg, $file, $line, $sub, $depth) = @$details; |
353
|
|
|
|
|
|
|
|
354
|
2
|
|
|
|
|
6
|
my $oldframe = $ctx->{trace}->frame; |
355
|
2
|
|
|
|
|
3
|
my $olddepth = $ctx->{_depth}; |
356
|
|
|
|
|
|
|
|
357
|
2
|
|
|
|
|
153
|
my $mess = longmess(); |
358
|
|
|
|
|
|
|
|
359
|
2
|
|
|
|
|
336
|
warn <<" EOT"; |
360
|
|
|
|
|
|
|
$msg |
361
|
|
|
|
|
|
|
Old context details: |
362
|
|
|
|
|
|
|
File: $oldframe->[1] |
363
|
|
|
|
|
|
|
Line: $oldframe->[2] |
364
|
|
|
|
|
|
|
Tool: $oldframe->[3] |
365
|
|
|
|
|
|
|
Depth: $olddepth |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
New context details: |
368
|
|
|
|
|
|
|
File: $file |
369
|
|
|
|
|
|
|
Line: $line |
370
|
|
|
|
|
|
|
Tool: $sub |
371
|
|
|
|
|
|
|
Depth: $depth |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
Trace: $mess |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
Removing the old context and creating a new one... |
376
|
|
|
|
|
|
|
EOT |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub release($;$) { |
380
|
0
|
|
|
0
|
1
|
0
|
$_[0]->release; |
381
|
0
|
|
|
|
|
0
|
return $_[1]; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub intercept(&) { |
385
|
13
|
|
|
13
|
1
|
82
|
my $code = shift; |
386
|
|
|
|
|
|
|
|
387
|
13
|
|
|
|
|
25
|
my $ctx = context(); |
388
|
|
|
|
|
|
|
|
389
|
13
|
|
|
|
|
13
|
my $ipc; |
390
|
13
|
100
|
|
|
|
34
|
if (my $global_ipc = test2_ipc()) { |
391
|
10
|
|
|
|
|
26
|
my $driver = blessed($global_ipc); |
392
|
10
|
|
|
|
|
50
|
$ipc = $driver->new; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
13
|
|
|
|
|
79
|
my $hub = Test2::Hub::Interceptor->new( |
396
|
|
|
|
|
|
|
ipc => $ipc, |
397
|
|
|
|
|
|
|
no_ending => 1, |
398
|
|
|
|
|
|
|
); |
399
|
|
|
|
|
|
|
|
400
|
13
|
|
|
|
|
15
|
my @events; |
401
|
13
|
|
|
78
|
|
85
|
$hub->listen(sub { push @events => $_[1] }); |
|
78
|
|
|
|
|
155
|
|
402
|
|
|
|
|
|
|
|
403
|
13
|
|
|
|
|
35
|
$ctx->stack->top; # Make sure there is a top hub before we begin. |
404
|
13
|
|
|
|
|
28
|
$ctx->stack->push($hub); |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# Do not use 'try' cause it localizes __DIE__ |
407
|
13
|
|
|
|
|
12
|
my ($ok, $err); |
408
|
|
|
|
|
|
|
{ |
409
|
13
|
|
|
|
|
11
|
$ok = eval { $code->(hub => $hub, context => $ctx->snapshot); 1 }; |
|
13
|
|
|
|
|
14
|
|
|
13
|
|
|
|
|
34
|
|
|
10
|
|
|
|
|
19
|
|
410
|
13
|
|
|
|
|
27
|
$err = $@; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
13
|
|
|
|
|
40
|
$hub->cull; |
414
|
13
|
|
|
|
|
31
|
$ctx->stack->pop($hub); |
415
|
|
|
|
|
|
|
|
416
|
13
|
|
|
|
|
26
|
my $trace = $ctx->trace; |
417
|
13
|
|
|
|
|
26
|
$ctx->release; |
418
|
|
|
|
|
|
|
|
419
|
13
|
100
|
66
|
|
|
49
|
die $err unless $ok |
|
|
|
66
|
|
|
|
|
420
|
|
|
|
|
|
|
|| (blessed($err) && $err->isa('Test2::Hub::Interceptor::Terminator')); |
421
|
|
|
|
|
|
|
|
422
|
12
|
100
|
100
|
|
|
56
|
$hub->finalize($trace, 1) |
|
|
|
100
|
|
|
|
|
423
|
|
|
|
|
|
|
if $ok |
424
|
|
|
|
|
|
|
&& !$hub->no_ending |
425
|
|
|
|
|
|
|
&& !$hub->ended; |
426
|
|
|
|
|
|
|
|
427
|
12
|
|
|
|
|
43
|
return \@events; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
sub run_subtest { |
431
|
40
|
|
|
40
|
1
|
216
|
my ($name, $code, $params, @args) = @_; |
432
|
|
|
|
|
|
|
|
433
|
40
|
50
|
|
|
|
100
|
$params = { buffered => $params } unless ref $params; |
434
|
40
|
|
|
|
|
53
|
my $buffered = delete $params->{buffered}; |
435
|
|
|
|
|
|
|
|
436
|
40
|
|
|
|
|
49
|
my $ctx = context(); |
437
|
|
|
|
|
|
|
|
438
|
40
|
100
|
|
|
|
95
|
$ctx->note($name) unless $buffered; |
439
|
|
|
|
|
|
|
|
440
|
40
|
|
|
|
|
101
|
my $parent = $ctx->hub; |
441
|
|
|
|
|
|
|
|
442
|
40
|
|
33
|
|
|
77
|
my $stack = $ctx->stack || $STACK; |
443
|
40
|
|
|
|
|
109
|
my $hub = $stack->new_hub( |
444
|
|
|
|
|
|
|
class => 'Test2::Hub::Subtest', |
445
|
|
|
|
|
|
|
%$params, |
446
|
|
|
|
|
|
|
); |
447
|
|
|
|
|
|
|
|
448
|
40
|
|
|
|
|
33
|
my @events; |
449
|
40
|
50
|
|
|
|
225
|
$hub->set_nested( $parent->isa('Test2::Hub::Subtest') ? $parent->nested + 1 : 1 ); |
450
|
40
|
|
|
193
|
|
199
|
$hub->listen(sub { push @events => $_[1] }); |
|
193
|
|
|
|
|
367
|
|
451
|
|
|
|
|
|
|
|
452
|
40
|
100
|
|
|
|
65
|
if ($buffered) { |
453
|
36
|
100
|
|
|
|
86
|
if (my $format = $hub->format) { |
454
|
34
|
100
|
|
|
|
169
|
my $hide = $format->can('hide_buffered') ? $format->hide_buffered : 1; |
455
|
34
|
100
|
|
|
|
87
|
$hub->format(undef) if $hide; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
40
|
|
|
|
|
29
|
my ($ok, $err, $finished); |
460
|
|
|
|
|
|
|
T2_SUBTEST_WRAPPER: { |
461
|
|
|
|
|
|
|
# Do not use 'try' cause it localizes __DIE__ |
462
|
40
|
|
|
|
|
42
|
$ok = eval { $code->(@args); 1 }; |
|
40
|
|
|
|
|
43
|
|
|
40
|
|
|
|
|
74
|
|
|
39
|
|
|
|
|
101
|
|
463
|
39
|
|
|
|
|
41
|
$err = $@; |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# They might have done 'BEGIN { skip_all => "whatever" }' |
466
|
39
|
50
|
33
|
|
|
98
|
if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/) { |
467
|
0
|
|
|
|
|
0
|
$ok = undef; |
468
|
0
|
|
|
|
|
0
|
$err = undef; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
else { |
471
|
39
|
|
|
|
|
41
|
$finished = 1; |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
} |
474
|
39
|
|
|
|
|
93
|
$stack->pop($hub); |
475
|
|
|
|
|
|
|
|
476
|
39
|
|
|
|
|
68
|
my $trace = $ctx->trace; |
477
|
|
|
|
|
|
|
|
478
|
39
|
50
|
|
|
|
64
|
if (!$finished) { |
479
|
0
|
0
|
|
|
|
0
|
if(my $bailed = $hub->bailed_out) { |
480
|
0
|
|
|
|
|
0
|
$ctx->bail($bailed->reason); |
481
|
|
|
|
|
|
|
} |
482
|
0
|
|
|
|
|
0
|
my $code = $hub->exit_code; |
483
|
0
|
|
|
|
|
0
|
$ok = !$code; |
484
|
0
|
0
|
|
|
|
0
|
$err = "Subtest ended with exit code $code" if $code; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
39
|
50
|
33
|
|
|
142
|
$hub->finalize($trace, 1) |
|
|
|
33
|
|
|
|
|
488
|
|
|
|
|
|
|
if $ok |
489
|
|
|
|
|
|
|
&& !$hub->no_ending |
490
|
|
|
|
|
|
|
&& !$hub->ended; |
491
|
|
|
|
|
|
|
|
492
|
39
|
|
66
|
|
|
98
|
my $pass = $ok && $hub->is_passing; |
493
|
39
|
|
|
|
|
85
|
my $e = $ctx->build_event( |
494
|
|
|
|
|
|
|
'Subtest', |
495
|
|
|
|
|
|
|
pass => $pass, |
496
|
|
|
|
|
|
|
name => $name, |
497
|
|
|
|
|
|
|
subtest_id => $hub->id, |
498
|
|
|
|
|
|
|
buffered => $buffered, |
499
|
|
|
|
|
|
|
subevents => \@events, |
500
|
|
|
|
|
|
|
); |
501
|
|
|
|
|
|
|
|
502
|
39
|
|
|
|
|
115
|
my $plan_ok = $hub->check_plan; |
503
|
|
|
|
|
|
|
|
504
|
39
|
|
|
|
|
73
|
$ctx->hub->send($e); |
505
|
|
|
|
|
|
|
|
506
|
39
|
100
|
|
|
|
92
|
$ctx->failure_diag($e) unless $e->pass; |
507
|
|
|
|
|
|
|
|
508
|
39
|
50
|
|
|
|
62
|
$ctx->diag("Caught exception in subtest: $err") unless $ok; |
509
|
|
|
|
|
|
|
|
510
|
39
|
50
|
66
|
|
|
115
|
$ctx->diag("Bad subtest plan, expected " . $hub->plan . " but ran " . $hub->count) |
511
|
|
|
|
|
|
|
if defined($plan_ok) && !$plan_ok; |
512
|
|
|
|
|
|
|
|
513
|
39
|
|
|
|
|
72
|
$ctx->release; |
514
|
39
|
|
|
|
|
271
|
return $pass; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
1; |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
__END__ |