line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test2::Hub; |
2
|
54
|
|
|
54
|
|
663
|
use strict; |
|
54
|
|
|
|
|
55
|
|
|
54
|
|
|
|
|
1139
|
|
3
|
54
|
|
|
54
|
|
139
|
use warnings; |
|
54
|
|
|
|
|
52
|
|
|
54
|
|
|
|
|
1636
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.000042'; |
6
|
|
|
|
|
|
|
|
7
|
54
|
|
|
54
|
|
167
|
use Carp qw/carp croak confess/; |
|
54
|
|
|
|
|
43
|
|
|
54
|
|
|
|
|
2317
|
|
8
|
54
|
|
|
54
|
|
213
|
use Test2::Util qw/get_tid/; |
|
54
|
|
|
|
|
56
|
|
|
54
|
|
|
|
|
1749
|
|
9
|
|
|
|
|
|
|
|
10
|
54
|
|
|
54
|
|
173
|
use Scalar::Util qw/weaken/; |
|
54
|
|
|
|
|
48
|
|
|
54
|
|
|
|
|
1869
|
|
11
|
|
|
|
|
|
|
|
12
|
54
|
|
|
54
|
|
16413
|
use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/; |
|
54
|
|
|
|
|
73
|
|
|
54
|
|
|
|
|
3461
|
|
13
|
54
|
|
|
|
|
240
|
use Test2::Util::HashBase qw{ |
14
|
|
|
|
|
|
|
pid tid hid ipc |
15
|
|
|
|
|
|
|
no_ending |
16
|
|
|
|
|
|
|
_filters |
17
|
|
|
|
|
|
|
_pre_filters |
18
|
|
|
|
|
|
|
_listeners |
19
|
|
|
|
|
|
|
_follow_ups |
20
|
|
|
|
|
|
|
_formatter |
21
|
|
|
|
|
|
|
_context_acquire |
22
|
|
|
|
|
|
|
_context_init |
23
|
|
|
|
|
|
|
_context_release |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
count |
26
|
|
|
|
|
|
|
failed |
27
|
|
|
|
|
|
|
ended |
28
|
|
|
|
|
|
|
bailed_out |
29
|
|
|
|
|
|
|
_passing |
30
|
|
|
|
|
|
|
_plan |
31
|
|
|
|
|
|
|
skip_reason |
32
|
54
|
|
|
54
|
|
213
|
}; |
|
54
|
|
|
|
|
51
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my $ID_POSTFIX = 1; |
35
|
|
|
|
|
|
|
sub init { |
36
|
169
|
|
|
169
|
0
|
209
|
my $self = shift; |
37
|
|
|
|
|
|
|
|
38
|
169
|
|
|
|
|
454
|
$self->{+PID} = $$; |
39
|
169
|
|
|
|
|
245
|
$self->{+TID} = get_tid(); |
40
|
169
|
|
|
|
|
554
|
$self->{+HID} = join '-', $self->{+PID}, $self->{+TID}, $ID_POSTFIX++; |
41
|
|
|
|
|
|
|
|
42
|
169
|
|
|
|
|
213
|
$self->{+COUNT} = 0; |
43
|
169
|
|
|
|
|
193
|
$self->{+FAILED} = 0; |
44
|
169
|
|
|
|
|
200
|
$self->{+_PASSING} = 1; |
45
|
|
|
|
|
|
|
|
46
|
169
|
100
|
|
|
|
361
|
if (my $formatter = delete $self->{formatter}) { |
47
|
5
|
|
|
|
|
9
|
$self->format($formatter); |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
169
|
100
|
|
|
|
427
|
if (my $ipc = $self->{+IPC}) { |
51
|
12
|
|
|
|
|
40
|
$ipc->add_hub($self->{+HID}); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub reset_state { |
56
|
3
|
|
|
3
|
1
|
8
|
my $self = shift; |
57
|
|
|
|
|
|
|
|
58
|
3
|
|
|
|
|
9
|
$self->{+COUNT} = 0; |
59
|
3
|
|
|
|
|
4
|
$self->{+FAILED} = 0; |
60
|
3
|
|
|
|
|
3
|
$self->{+_PASSING} = 1; |
61
|
|
|
|
|
|
|
|
62
|
3
|
|
|
|
|
2
|
delete $self->{+_PLAN}; |
63
|
3
|
|
|
|
|
4
|
delete $self->{+ENDED}; |
64
|
3
|
|
|
|
|
3
|
delete $self->{+BAILED_OUT}; |
65
|
3
|
|
|
|
|
5
|
delete $self->{+SKIP_REASON}; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub inherit { |
69
|
59
|
|
|
59
|
0
|
50
|
my $self = shift; |
70
|
59
|
|
|
|
|
84
|
my ($from, %params) = @_; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
$self->{+_FORMATTER} = $from->{+_FORMATTER} |
73
|
59
|
100
|
33
|
|
|
245
|
unless $self->{+_FORMATTER} || exists($params{formatter}); |
74
|
|
|
|
|
|
|
|
75
|
59
|
100
|
66
|
|
|
219
|
if ($from->{+IPC} && !$self->{+IPC} && !exists($params{ipc})) { |
|
|
|
100
|
|
|
|
|
76
|
25
|
|
|
|
|
28
|
my $ipc = $from->{+IPC}; |
77
|
25
|
|
|
|
|
38
|
$self->{+IPC} = $ipc; |
78
|
25
|
|
|
|
|
60
|
$ipc->add_hub($self->{+HID}); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
59
|
100
|
|
|
|
201
|
if (my $ls = $from->{+_LISTENERS}) { |
82
|
9
|
|
|
|
|
5
|
push @{$self->{+_LISTENERS}} => grep { $_->{inherit} } @$ls; |
|
9
|
|
|
|
|
21
|
|
|
9
|
|
|
|
|
13
|
|
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
59
|
100
|
|
|
|
168
|
if (my $fs = $from->{+_FILTERS}) { |
86
|
12
|
|
|
|
|
9
|
push @{$self->{+_FILTERS}} => grep { $_->{inherit} } @$fs; |
|
12
|
|
|
|
|
42
|
|
|
6
|
|
|
|
|
27
|
|
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub format { |
91
|
248
|
|
|
248
|
1
|
280
|
my $self = shift; |
92
|
|
|
|
|
|
|
|
93
|
248
|
|
|
|
|
259
|
my $old = $self->{+_FORMATTER}; |
94
|
248
|
100
|
|
|
|
556
|
($self->{+_FORMATTER}) = @_ if @_; |
95
|
|
|
|
|
|
|
|
96
|
248
|
|
|
|
|
832
|
return $old; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub is_local { |
100
|
6
|
|
|
6
|
0
|
7
|
my $self = shift; |
101
|
|
|
|
|
|
|
return $$ == $self->{+PID} |
102
|
6
|
|
66
|
|
|
39
|
&& get_tid() == $self->{+TID}; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub listen { |
106
|
58
|
|
|
58
|
1
|
90
|
my $self = shift; |
107
|
58
|
|
|
|
|
69
|
my ($sub, %params) = @_; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
carp "Useless addition of a listener in a child process or thread!" |
110
|
58
|
50
|
33
|
|
|
308
|
if $$ != $self->{+PID} || get_tid() != $self->{+TID}; |
111
|
|
|
|
|
|
|
|
112
|
58
|
100
|
66
|
|
|
443
|
croak "listen only takes coderefs for arguments, got '$sub'" |
113
|
|
|
|
|
|
|
unless ref $sub && ref $sub eq 'CODE'; |
114
|
|
|
|
|
|
|
|
115
|
57
|
|
|
|
|
49
|
push @{$self->{+_LISTENERS}} => { %params, code => $sub }; |
|
57
|
|
|
|
|
169
|
|
116
|
|
|
|
|
|
|
|
117
|
57
|
|
|
|
|
99
|
$sub; # Intentional return. |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub unlisten { |
121
|
1
|
|
|
1
|
1
|
4
|
my $self = shift; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
carp "Useless removal of a listener in a child process or thread!" |
124
|
1
|
50
|
33
|
|
|
10
|
if $$ != $self->{+PID} || get_tid() != $self->{+TID}; |
125
|
|
|
|
|
|
|
|
126
|
1
|
|
|
|
|
3
|
my %subs = map {$_ => $_} @_; |
|
1
|
|
|
|
|
5
|
|
127
|
|
|
|
|
|
|
|
128
|
1
|
|
|
|
|
1
|
@{$self->{+_LISTENERS}} = grep { !$subs{$_->{code}} } @{$self->{+_LISTENERS}}; |
|
1
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
3
|
|
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub filter { |
132
|
11
|
|
|
11
|
1
|
57
|
my $self = shift; |
133
|
11
|
|
|
|
|
17
|
my ($sub, %params) = @_; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
carp "Useless addition of a filter in a child process or thread!" |
136
|
11
|
50
|
33
|
|
|
69
|
if $$ != $self->{+PID} || get_tid() != $self->{+TID}; |
137
|
|
|
|
|
|
|
|
138
|
11
|
100
|
66
|
|
|
119
|
croak "filter only takes coderefs for arguments, got '$sub'" |
139
|
|
|
|
|
|
|
unless ref $sub && ref $sub eq 'CODE'; |
140
|
|
|
|
|
|
|
|
141
|
10
|
|
|
|
|
10
|
push @{$self->{+_FILTERS}} => { %params, code => $sub }; |
|
10
|
|
|
|
|
36
|
|
142
|
|
|
|
|
|
|
|
143
|
10
|
|
|
|
|
20
|
$sub; # Intentional Return |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub unfilter { |
147
|
2
|
|
|
2
|
1
|
6
|
my $self = shift; |
148
|
|
|
|
|
|
|
carp "Useless removal of a filter in a child process or thread!" |
149
|
2
|
50
|
33
|
|
|
17
|
if $$ != $self->{+PID} || get_tid() != $self->{+TID}; |
150
|
2
|
|
|
|
|
4
|
my %subs = map {$_ => $_} @_; |
|
2
|
|
|
|
|
7
|
|
151
|
2
|
|
|
|
|
3
|
@{$self->{+_FILTERS}} = grep { !$subs{$_->{code}} } @{$self->{+_FILTERS}}; |
|
2
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
5
|
|
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub pre_filter { |
155
|
4
|
|
|
4
|
1
|
35
|
my $self = shift; |
156
|
4
|
|
|
|
|
5
|
my ($sub, %params) = @_; |
157
|
|
|
|
|
|
|
|
158
|
4
|
100
|
66
|
|
|
79
|
croak "pre_filter only takes coderefs for arguments, got '$sub'" |
159
|
|
|
|
|
|
|
unless ref $sub && ref $sub eq 'CODE'; |
160
|
|
|
|
|
|
|
|
161
|
3
|
|
|
|
|
3
|
push @{$self->{+_PRE_FILTERS}} => { %params, code => $sub }; |
|
3
|
|
|
|
|
8
|
|
162
|
|
|
|
|
|
|
|
163
|
3
|
|
|
|
|
4
|
$sub; # Intentional Return |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub pre_unfilter { |
167
|
1
|
|
|
1
|
1
|
4
|
my $self = shift; |
168
|
1
|
|
|
|
|
3
|
my %subs = map {$_ => $_} @_; |
|
1
|
|
|
|
|
3
|
|
169
|
1
|
|
|
|
|
5
|
@{$self->{+_PRE_FILTERS}} = grep { !$subs{$_->{code}} } @{$self->{+_PRE_FILTERS}}; |
|
1
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
1
|
|
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub follow_up { |
173
|
4
|
|
|
4
|
0
|
42
|
my $self = shift; |
174
|
4
|
|
|
|
|
6
|
my ($sub) = @_; |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
carp "Useless addition of a follow-up in a child process or thread!" |
177
|
4
|
50
|
33
|
|
|
16
|
if $$ != $self->{+PID} || get_tid() != $self->{+TID}; |
178
|
|
|
|
|
|
|
|
179
|
4
|
100
|
66
|
|
|
228
|
croak "follow_up only takes coderefs for arguments, got '$sub'" |
180
|
|
|
|
|
|
|
unless ref $sub && ref $sub eq 'CODE'; |
181
|
|
|
|
|
|
|
|
182
|
2
|
|
|
|
|
2
|
push @{$self->{+_FOLLOW_UPS}} => $sub; |
|
2
|
|
|
|
|
6
|
|
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
*add_context_aquire = \&add_context_acquire; |
186
|
|
|
|
|
|
|
sub add_context_acquire { |
187
|
1
|
|
|
1
|
1
|
10
|
my $self = shift; |
188
|
1
|
|
|
|
|
1
|
my ($sub) = @_; |
189
|
|
|
|
|
|
|
|
190
|
1
|
50
|
33
|
|
|
5
|
croak "add_context_acquire only takes coderefs for arguments, got '$sub'" |
191
|
|
|
|
|
|
|
unless ref $sub && ref $sub eq 'CODE'; |
192
|
|
|
|
|
|
|
|
193
|
1
|
|
|
|
|
1
|
push @{$self->{+_CONTEXT_ACQUIRE}} => $sub; |
|
1
|
|
|
|
|
2
|
|
194
|
|
|
|
|
|
|
|
195
|
1
|
|
|
|
|
2
|
$sub; # Intentional return. |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
*remove_context_aquire = \&remove_context_acquire; |
199
|
|
|
|
|
|
|
sub remove_context_acquire { |
200
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
201
|
1
|
|
|
|
|
8
|
my %subs = map {$_ => $_} @_; |
|
1
|
|
|
|
|
3
|
|
202
|
1
|
|
|
|
|
1
|
@{$self->{+_CONTEXT_ACQUIRE}} = grep { !$subs{$_} == $_ } @{$self->{+_CONTEXT_ACQUIRE}}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub add_context_init { |
206
|
1
|
|
|
1
|
1
|
6
|
my $self = shift; |
207
|
1
|
|
|
|
|
1
|
my ($sub) = @_; |
208
|
|
|
|
|
|
|
|
209
|
1
|
50
|
33
|
|
|
6
|
croak "add_context_init only takes coderefs for arguments, got '$sub'" |
210
|
|
|
|
|
|
|
unless ref $sub && ref $sub eq 'CODE'; |
211
|
|
|
|
|
|
|
|
212
|
1
|
|
|
|
|
2
|
push @{$self->{+_CONTEXT_INIT}} => $sub; |
|
1
|
|
|
|
|
3
|
|
213
|
|
|
|
|
|
|
|
214
|
1
|
|
|
|
|
2
|
$sub; # Intentional return. |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub remove_context_init { |
218
|
1
|
|
|
1
|
1
|
6
|
my $self = shift; |
219
|
1
|
|
|
|
|
2
|
my %subs = map {$_ => $_} @_; |
|
1
|
|
|
|
|
3
|
|
220
|
1
|
|
|
|
|
1
|
@{$self->{+_CONTEXT_INIT}} = grep { !$subs{$_} == $_ } @{$self->{+_CONTEXT_INIT}}; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub add_context_release { |
224
|
1
|
|
|
1
|
1
|
4
|
my $self = shift; |
225
|
1
|
|
|
|
|
2
|
my ($sub) = @_; |
226
|
|
|
|
|
|
|
|
227
|
1
|
50
|
33
|
|
|
5
|
croak "add_context_release only takes coderefs for arguments, got '$sub'" |
228
|
|
|
|
|
|
|
unless ref $sub && ref $sub eq 'CODE'; |
229
|
|
|
|
|
|
|
|
230
|
1
|
|
|
|
|
1
|
push @{$self->{+_CONTEXT_RELEASE}} => $sub; |
|
1
|
|
|
|
|
2
|
|
231
|
|
|
|
|
|
|
|
232
|
1
|
|
|
|
|
2
|
$sub; # Intentional return. |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub remove_context_release { |
236
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
237
|
1
|
|
|
|
|
1
|
my %subs = map {$_ => $_} @_; |
|
1
|
|
|
|
|
3
|
|
238
|
1
|
|
|
|
|
1
|
@{$self->{+_CONTEXT_RELEASE}} = grep { !$subs{$_} == $_ } @{$self->{+_CONTEXT_RELEASE}}; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
sub send { |
242
|
1224
|
|
|
1224
|
1
|
1711
|
my $self = shift; |
243
|
1224
|
|
|
|
|
1003
|
my ($e) = @_; |
244
|
|
|
|
|
|
|
|
245
|
1224
|
100
|
|
|
|
1915
|
if ($self->{+_PRE_FILTERS}) { |
246
|
6
|
|
|
|
|
3
|
for (@{$self->{+_PRE_FILTERS}}) { |
|
6
|
|
|
|
|
10
|
|
247
|
8
|
|
|
|
|
12
|
$e = $_->{code}->($self, $e); |
248
|
8
|
100
|
|
|
|
23
|
return unless $e; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
1221
|
|
100
|
|
|
2354
|
my $ipc = $self->{+IPC} || return $self->process($e); |
253
|
|
|
|
|
|
|
|
254
|
626
|
100
|
|
|
|
1532
|
if($e->global) { |
255
|
1
|
|
|
|
|
4
|
$ipc->send($self->{+HID}, $e, 'GLOBAL'); |
256
|
1
|
|
|
|
|
5
|
return $self->process($e); |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
return $ipc->send($self->{+HID}, $e) |
260
|
625
|
100
|
66
|
|
|
2560
|
if $$ != $self->{+PID} || get_tid() != $self->{+TID}; |
261
|
|
|
|
|
|
|
|
262
|
614
|
|
|
|
|
920
|
$self->process($e); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub process { |
266
|
1232
|
|
|
1232
|
1
|
937
|
my $self = shift; |
267
|
1232
|
|
|
|
|
923
|
my ($e) = @_; |
268
|
|
|
|
|
|
|
|
269
|
1232
|
100
|
|
|
|
1713
|
if ($self->{+_FILTERS}) { |
270
|
18
|
|
|
|
|
16
|
for (@{$self->{+_FILTERS}}) { |
|
18
|
|
|
|
|
34
|
|
271
|
17
|
|
|
|
|
26
|
$e = $_->{code}->($self, $e); |
272
|
17
|
100
|
|
|
|
78
|
return unless $e; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
1223
|
|
|
|
|
1255
|
my $type = ref($e); |
277
|
1223
|
|
|
|
|
1158
|
my $is_ok = $type eq 'Test2::Event::Ok'; |
278
|
1223
|
|
100
|
|
|
2816
|
my $no_fail = $type eq 'Test2::Event::Diag' || $type eq 'Test2::Event::Note'; |
279
|
1223
|
100
|
|
|
|
2224
|
my $causes_fail = $is_ok ? !$e->{effective_pass} : $no_fail ? 0 : $e->causes_fail; |
|
|
100
|
|
|
|
|
|
280
|
|
|
|
|
|
|
|
281
|
1223
|
100
|
100
|
|
|
2917
|
$self->{+COUNT}++ if $is_ok || (!$no_fail && $e->increments_count); |
|
|
|
66
|
|
|
|
|
282
|
1223
|
100
|
100
|
|
|
1709
|
$self->{+FAILED}++ and $self->{+_PASSING} = 0 if $causes_fail; |
283
|
|
|
|
|
|
|
|
284
|
1223
|
100
|
100
|
|
|
2735
|
my $callback = $e->callback($self) unless $is_ok || $no_fail; |
285
|
|
|
|
|
|
|
|
286
|
1223
|
|
|
|
|
1282
|
my $count = $self->{+COUNT}; |
287
|
|
|
|
|
|
|
|
288
|
1223
|
100
|
|
|
|
3212
|
$self->{+_FORMATTER}->write($e, $count) if $self->{+_FORMATTER}; |
289
|
|
|
|
|
|
|
|
290
|
1223
|
100
|
|
|
|
3075
|
if ($self->{+_LISTENERS}) { |
291
|
274
|
|
|
|
|
188
|
$_->{code}->($self, $e, $count) for @{$self->{+_LISTENERS}}; |
|
274
|
|
|
|
|
884
|
|
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
1223
|
100
|
100
|
|
|
4112
|
return $e if $is_ok || $no_fail; |
295
|
|
|
|
|
|
|
|
296
|
162
|
|
|
|
|
468
|
my $code = $e->terminate; |
297
|
162
|
100
|
|
|
|
385
|
$self->terminate($code, $e) if defined $code; |
298
|
|
|
|
|
|
|
|
299
|
157
|
|
|
|
|
345
|
return $e; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub terminate { |
303
|
2
|
|
|
2
|
0
|
4
|
my $self = shift; |
304
|
2
|
|
|
|
|
3
|
my ($code) = @_; |
305
|
2
|
|
|
|
|
18
|
exit($code); |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub cull { |
309
|
139
|
|
|
139
|
1
|
149
|
my $self = shift; |
310
|
|
|
|
|
|
|
|
311
|
139
|
|
100
|
|
|
347
|
my $ipc = $self->{+IPC} || return; |
312
|
69
|
100
|
66
|
|
|
401
|
return if $self->{+PID} != $$ || $self->{+TID} != get_tid(); |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# No need to do IPC checks on culled events |
315
|
63
|
|
|
|
|
207
|
$self->process($_) for $ipc->cull($self->{+HID}); |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub finalize { |
319
|
108
|
|
|
108
|
0
|
144
|
my $self = shift; |
320
|
108
|
|
|
|
|
141
|
my ($trace, $do_plan) = @_; |
321
|
|
|
|
|
|
|
|
322
|
108
|
|
|
|
|
243
|
$self->cull(); |
323
|
|
|
|
|
|
|
|
324
|
108
|
|
|
|
|
170
|
my $plan = $self->{+_PLAN}; |
325
|
108
|
|
|
|
|
112
|
my $count = $self->{+COUNT}; |
326
|
108
|
|
|
|
|
119
|
my $failed = $self->{+FAILED}; |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# return if NOTHING was done. |
329
|
108
|
100
|
100
|
|
|
593
|
return unless $do_plan || defined($plan) || $count || $failed; |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
330
|
|
|
|
|
|
|
|
331
|
94
|
100
|
|
|
|
224
|
unless ($self->{+ENDED}) { |
332
|
91
|
100
|
|
|
|
196
|
if ($self->{+_FOLLOW_UPS}) { |
333
|
2
|
|
|
|
|
2
|
$_->($trace, $self) for reverse @{$self->{+_FOLLOW_UPS}}; |
|
2
|
|
|
|
|
10
|
|
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# These need to be refreshed now |
337
|
91
|
|
|
|
|
106
|
$plan = $self->{+_PLAN}; |
338
|
91
|
|
|
|
|
92
|
$count = $self->{+COUNT}; |
339
|
91
|
|
|
|
|
93
|
$failed = $self->{+FAILED}; |
340
|
|
|
|
|
|
|
|
341
|
91
|
100
|
100
|
|
|
634
|
if (($plan && $plan eq 'NO PLAN') || ($do_plan && !$plan)) { |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
342
|
80
|
|
|
|
|
401
|
$self->send( |
343
|
|
|
|
|
|
|
Test2::Event::Plan->new( |
344
|
|
|
|
|
|
|
trace => $trace, |
345
|
|
|
|
|
|
|
max => $count, |
346
|
|
|
|
|
|
|
) |
347
|
|
|
|
|
|
|
); |
348
|
|
|
|
|
|
|
} |
349
|
91
|
|
|
|
|
287
|
$plan = $self->{+_PLAN}; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
94
|
|
|
|
|
220
|
my $frame = $trace->frame; |
353
|
94
|
100
|
|
|
|
218
|
if($self->{+ENDED}) { |
354
|
3
|
|
|
|
|
5
|
my (undef, $ffile, $fline) = @{$self->{+ENDED}}; |
|
3
|
|
|
|
|
8
|
|
355
|
3
|
|
|
|
|
5
|
my (undef, $sfile, $sline) = @$frame; |
356
|
|
|
|
|
|
|
|
357
|
3
|
|
|
|
|
15
|
die <<" EOT" |
358
|
|
|
|
|
|
|
Test already ended! |
359
|
|
|
|
|
|
|
First End: $ffile line $fline |
360
|
|
|
|
|
|
|
Second End: $sfile line $sline |
361
|
|
|
|
|
|
|
EOT |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
91
|
|
|
|
|
120
|
$self->{+ENDED} = $frame; |
365
|
91
|
|
|
|
|
220
|
$self->is_passing(); # Generate the final boolean. |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub is_passing { |
369
|
203
|
|
|
203
|
1
|
190
|
my $self = shift; |
370
|
|
|
|
|
|
|
|
371
|
203
|
100
|
|
|
|
329
|
($self->{+_PASSING}) = @_ if @_; |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# If we already failed just return 0. |
374
|
203
|
|
100
|
|
|
367
|
my $pass = $self->{+_PASSING} || return 0; |
375
|
191
|
100
|
|
|
|
302
|
return $self->{+_PASSING} = 0 if $self->{+FAILED}; |
376
|
|
|
|
|
|
|
|
377
|
183
|
|
|
|
|
171
|
my $count = $self->{+COUNT}; |
378
|
183
|
|
|
|
|
180
|
my $ended = $self->{+ENDED}; |
379
|
183
|
|
|
|
|
174
|
my $plan = $self->{+_PLAN}; |
380
|
|
|
|
|
|
|
|
381
|
183
|
100
|
100
|
|
|
435
|
return $pass if !$count && $plan && $plan =~ m/^SKIP$/; |
|
|
|
66
|
|
|
|
|
382
|
|
|
|
|
|
|
|
383
|
181
|
100
|
100
|
|
|
780
|
return $self->{+_PASSING} = 0 |
|
|
|
100
|
|
|
|
|
384
|
|
|
|
|
|
|
if $ended && (!$count || !$plan); |
385
|
|
|
|
|
|
|
|
386
|
171
|
100
|
66
|
|
|
718
|
return $pass unless $plan && $plan =~ m/^\d+$/; |
387
|
|
|
|
|
|
|
|
388
|
106
|
50
|
|
|
|
178
|
if ($ended) { |
389
|
106
|
50
|
|
|
|
206
|
return $self->{+_PASSING} = 0 if $count != $plan; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
else { |
392
|
0
|
0
|
|
|
|
0
|
return $self->{+_PASSING} = 0 if $count > $plan; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
106
|
|
|
|
|
213
|
return $pass; |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
sub plan { |
399
|
115
|
|
|
115
|
1
|
135
|
my $self = shift; |
400
|
|
|
|
|
|
|
|
401
|
115
|
100
|
|
|
|
271
|
return $self->{+_PLAN} unless @_; |
402
|
|
|
|
|
|
|
|
403
|
106
|
|
|
|
|
220
|
my ($plan) = @_; |
404
|
|
|
|
|
|
|
|
405
|
106
|
50
|
|
|
|
216
|
confess "You cannot unset the plan" |
406
|
|
|
|
|
|
|
unless defined $plan; |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
confess "You cannot change the plan" |
409
|
106
|
100
|
100
|
|
|
386
|
if $self->{+_PLAN} && $self->{+_PLAN} !~ m/^NO PLAN$/; |
410
|
|
|
|
|
|
|
|
411
|
105
|
100
|
|
|
|
516
|
confess "'$plan' is not a valid plan! Plan must be an integer greater than 0, 'NO PLAN', or 'SKIP'" |
412
|
|
|
|
|
|
|
unless $plan =~ m/^(\d+|NO PLAN|SKIP)$/; |
413
|
|
|
|
|
|
|
|
414
|
104
|
|
|
|
|
264
|
$self->{+_PLAN} = $plan; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
sub check_plan { |
418
|
39
|
|
|
39
|
1
|
24
|
my $self = shift; |
419
|
|
|
|
|
|
|
|
420
|
39
|
50
|
|
|
|
71
|
return undef unless $self->{+ENDED}; |
421
|
39
|
|
100
|
|
|
64
|
my $plan = $self->{+_PLAN} || return undef; |
422
|
|
|
|
|
|
|
|
423
|
31
|
50
|
|
|
|
94
|
return 1 if $plan !~ m/^\d+$/; |
424
|
|
|
|
|
|
|
|
425
|
31
|
50
|
|
|
|
85
|
return 1 if $plan == $self->{+COUNT}; |
426
|
0
|
|
|
|
|
0
|
return 0; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub DESTROY { |
430
|
113
|
|
|
113
|
|
734
|
my $self = shift; |
431
|
113
|
|
100
|
|
|
789
|
my $ipc = $self->{+IPC} || return; |
432
|
51
|
100
|
|
|
|
206
|
return unless $$ == $self->{+PID}; |
433
|
50
|
50
|
|
|
|
537
|
return unless get_tid() == $self->{+TID}; |
434
|
|
|
|
|
|
|
|
435
|
50
|
|
|
|
|
154
|
$ipc->drop_hub($self->{+HID}); |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
1; |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
__END__ |