line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test2::API; |
2
|
246
|
|
|
246
|
|
9662
|
use strict; |
|
246
|
|
|
|
|
539
|
|
|
246
|
|
|
|
|
7612
|
|
3
|
246
|
|
|
246
|
|
1233
|
use warnings; |
|
246
|
|
|
|
|
414
|
|
|
246
|
|
|
|
|
7267
|
|
4
|
|
|
|
|
|
|
|
5
|
246
|
|
|
246
|
|
6457
|
use Test2::Util qw/USE_THREADS/; |
|
246
|
|
|
|
|
417
|
|
|
246
|
|
|
|
|
14789
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
246
|
|
50
|
246
|
|
4168
|
$ENV{TEST_ACTIVE} ||= 1; |
9
|
246
|
|
|
|
|
65391
|
$ENV{TEST2_ACTIVE} = 1; |
10
|
|
|
|
|
|
|
} |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '1.302182'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $INST; |
16
|
|
|
|
|
|
|
my $ENDING = 0; |
17
|
217
|
|
|
217
|
0
|
594
|
sub test2_unset_is_end { $ENDING = 0 } |
18
|
3
|
|
|
3
|
1
|
18
|
sub test2_get_is_end { $ENDING } |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub test2_set_is_end { |
21
|
749
|
|
|
749
|
1
|
1795
|
my $before = $ENDING; |
22
|
749
|
50
|
|
|
|
3070
|
($ENDING) = @_ ? @_ : (1); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# Only send the event in a transition from false to true |
25
|
749
|
100
|
|
|
|
5119
|
return if $before; |
26
|
247
|
50
|
|
|
|
1434
|
return unless $ENDING; |
27
|
|
|
|
|
|
|
|
28
|
247
|
50
|
|
|
|
1153
|
return unless $INST; |
29
|
247
|
50
|
|
|
|
2438
|
my $stack = $INST->stack or return; |
30
|
247
|
100
|
|
|
|
2213
|
my $root = $stack->root or return; |
31
|
|
|
|
|
|
|
|
32
|
246
|
100
|
|
|
|
1977
|
return unless $root->count; |
33
|
|
|
|
|
|
|
|
34
|
218
|
100
|
|
|
|
2222
|
return unless $$ == $INST->pid; |
35
|
211
|
50
|
|
|
|
1507
|
return unless get_tid() == $INST->tid; |
36
|
|
|
|
|
|
|
|
37
|
211
|
|
|
|
|
2844
|
my $trace = Test2::EventFacet::Trace->new( |
38
|
|
|
|
|
|
|
frame => [__PACKAGE__, __FILE__, __LINE__, __PACKAGE__ . '::test2_set_is_end'], |
39
|
|
|
|
|
|
|
); |
40
|
211
|
|
|
|
|
1462
|
my $ctx = Test2::API::Context->new( |
41
|
|
|
|
|
|
|
trace => $trace, |
42
|
|
|
|
|
|
|
hub => $root, |
43
|
|
|
|
|
|
|
); |
44
|
|
|
|
|
|
|
|
45
|
211
|
|
|
|
|
2031
|
$ctx->send_ev2(control => { phase => 'END', details => 'Transition to END phase' }); |
46
|
|
|
|
|
|
|
|
47
|
211
|
|
|
|
|
1121
|
1; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
246
|
|
|
246
|
|
109555
|
use Test2::API::Instance(\$INST); |
|
246
|
|
|
|
|
714
|
|
|
246
|
|
|
|
|
1416
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# Set the exit status |
53
|
|
|
|
|
|
|
END { |
54
|
246
|
|
|
246
|
|
1829
|
test2_set_is_end(); # See gh #16 |
55
|
246
|
|
|
|
|
1964
|
$INST->set_exit(); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub CLONE { |
59
|
0
|
|
|
0
|
|
0
|
my $init = test2_init_done(); |
60
|
0
|
|
|
|
|
0
|
my $load = test2_load_done(); |
61
|
|
|
|
|
|
|
|
62
|
0
|
0
|
0
|
|
|
0
|
return if $init && $load; |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
0
|
require Carp; |
65
|
0
|
|
|
|
|
0
|
Carp::croak "Test2 must be fully loaded before you start a new thread!\n"; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# See gh #16 |
69
|
|
|
|
|
|
|
{ |
70
|
246
|
|
|
246
|
|
1979
|
no warnings; |
|
246
|
|
|
|
|
552
|
|
|
246
|
|
|
|
|
20859
|
|
71
|
237
|
50
|
|
237
|
|
18318
|
INIT { eval 'END { test2_set_is_end() }; 1' or die $@ } |
|
170
|
|
|
170
|
|
4340
|
|
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
BEGIN { |
75
|
246
|
|
|
246
|
|
1851
|
no warnings 'once'; |
|
246
|
|
|
|
|
615
|
|
|
246
|
|
|
|
|
27359
|
|
76
|
246
|
50
|
33
|
246
|
|
2131
|
if($] ge '5.014' || $ENV{T2_CHECK_DEPTH} || $Test2::API::DO_DEPTH_CHECK) { |
|
|
|
0
|
|
|
|
|
77
|
246
|
|
|
|
|
5355
|
*DO_DEPTH_CHECK = sub() { 1 }; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
else { |
80
|
0
|
|
|
|
|
0
|
*DO_DEPTH_CHECK = sub() { 0 }; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
246
|
|
|
246
|
|
1786
|
use Test2::EventFacet::Trace(); |
|
246
|
|
|
|
|
547
|
|
|
246
|
|
|
|
|
4973
|
|
85
|
246
|
|
|
246
|
|
113125
|
use Test2::Util::Trace(); # Legacy |
|
246
|
|
|
|
|
612
|
|
|
246
|
|
|
|
|
5554
|
|
86
|
|
|
|
|
|
|
|
87
|
246
|
|
|
246
|
|
96974
|
use Test2::Hub::Subtest(); |
|
246
|
|
|
|
|
612
|
|
|
246
|
|
|
|
|
4951
|
|
88
|
246
|
|
|
246
|
|
97990
|
use Test2::Hub::Interceptor(); |
|
246
|
|
|
|
|
648
|
|
|
246
|
|
|
|
|
5017
|
|
89
|
246
|
|
|
246
|
|
1495
|
use Test2::Hub::Interceptor::Terminator(); |
|
246
|
|
|
|
|
595
|
|
|
246
|
|
|
|
|
3560
|
|
90
|
|
|
|
|
|
|
|
91
|
246
|
|
|
246
|
|
98700
|
use Test2::Event::Ok(); |
|
246
|
|
|
|
|
677
|
|
|
246
|
|
|
|
|
5880
|
|
92
|
246
|
|
|
246
|
|
99448
|
use Test2::Event::Diag(); |
|
246
|
|
|
|
|
671
|
|
|
246
|
|
|
|
|
5036
|
|
93
|
246
|
|
|
246
|
|
97382
|
use Test2::Event::Note(); |
|
246
|
|
|
|
|
726
|
|
|
246
|
|
|
|
|
5037
|
|
94
|
246
|
|
|
246
|
|
97780
|
use Test2::Event::Plan(); |
|
246
|
|
|
|
|
653
|
|
|
246
|
|
|
|
|
5324
|
|
95
|
246
|
|
|
246
|
|
95649
|
use Test2::Event::Bail(); |
|
246
|
|
|
|
|
679
|
|
|
246
|
|
|
|
|
5133
|
|
96
|
246
|
|
|
246
|
|
95937
|
use Test2::Event::Exception(); |
|
246
|
|
|
|
|
655
|
|
|
246
|
|
|
|
|
4959
|
|
97
|
246
|
|
|
246
|
|
94612
|
use Test2::Event::Waiting(); |
|
246
|
|
|
|
|
676
|
|
|
246
|
|
|
|
|
4860
|
|
98
|
246
|
|
|
246
|
|
94266
|
use Test2::Event::Skip(); |
|
246
|
|
|
|
|
704
|
|
|
246
|
|
|
|
|
4898
|
|
99
|
246
|
|
|
246
|
|
97044
|
use Test2::Event::Subtest(); |
|
246
|
|
|
|
|
693
|
|
|
246
|
|
|
|
|
6398
|
|
100
|
|
|
|
|
|
|
|
101
|
246
|
|
|
246
|
|
1649
|
use Carp qw/carp croak confess/; |
|
246
|
|
|
|
|
516
|
|
|
246
|
|
|
|
|
14060
|
|
102
|
246
|
|
|
246
|
|
1560
|
use Scalar::Util qw/blessed weaken/; |
|
246
|
|
|
|
|
525
|
|
|
246
|
|
|
|
|
11288
|
|
103
|
246
|
|
|
246
|
|
1443
|
use Test2::Util qw/get_tid clone_io pkg_to_file gen_uid/; |
|
246
|
|
|
|
|
485
|
|
|
246
|
|
|
|
|
32608
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
our @EXPORT_OK = qw{ |
106
|
|
|
|
|
|
|
context release |
107
|
|
|
|
|
|
|
context_do |
108
|
|
|
|
|
|
|
no_context |
109
|
|
|
|
|
|
|
intercept intercept_deep |
110
|
|
|
|
|
|
|
run_subtest |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
test2_init_done |
113
|
|
|
|
|
|
|
test2_load_done |
114
|
|
|
|
|
|
|
test2_load |
115
|
|
|
|
|
|
|
test2_start_preload |
116
|
|
|
|
|
|
|
test2_stop_preload |
117
|
|
|
|
|
|
|
test2_in_preload |
118
|
|
|
|
|
|
|
test2_is_testing_done |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
test2_set_is_end |
121
|
|
|
|
|
|
|
test2_unset_is_end |
122
|
|
|
|
|
|
|
test2_get_is_end |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
test2_pid |
125
|
|
|
|
|
|
|
test2_tid |
126
|
|
|
|
|
|
|
test2_stack |
127
|
|
|
|
|
|
|
test2_no_wait |
128
|
|
|
|
|
|
|
test2_ipc_wait_enable |
129
|
|
|
|
|
|
|
test2_ipc_wait_disable |
130
|
|
|
|
|
|
|
test2_ipc_wait_enabled |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
test2_add_uuid_via |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
test2_add_callback_testing_done |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
test2_add_callback_context_aquire |
137
|
|
|
|
|
|
|
test2_add_callback_context_acquire |
138
|
|
|
|
|
|
|
test2_add_callback_context_init |
139
|
|
|
|
|
|
|
test2_add_callback_context_release |
140
|
|
|
|
|
|
|
test2_add_callback_exit |
141
|
|
|
|
|
|
|
test2_add_callback_post_load |
142
|
|
|
|
|
|
|
test2_add_callback_pre_subtest |
143
|
|
|
|
|
|
|
test2_list_context_aquire_callbacks |
144
|
|
|
|
|
|
|
test2_list_context_acquire_callbacks |
145
|
|
|
|
|
|
|
test2_list_context_init_callbacks |
146
|
|
|
|
|
|
|
test2_list_context_release_callbacks |
147
|
|
|
|
|
|
|
test2_list_exit_callbacks |
148
|
|
|
|
|
|
|
test2_list_post_load_callbacks |
149
|
|
|
|
|
|
|
test2_list_pre_subtest_callbacks |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
test2_ipc |
152
|
|
|
|
|
|
|
test2_has_ipc |
153
|
|
|
|
|
|
|
test2_ipc_disable |
154
|
|
|
|
|
|
|
test2_ipc_disabled |
155
|
|
|
|
|
|
|
test2_ipc_drivers |
156
|
|
|
|
|
|
|
test2_ipc_add_driver |
157
|
|
|
|
|
|
|
test2_ipc_polling |
158
|
|
|
|
|
|
|
test2_ipc_disable_polling |
159
|
|
|
|
|
|
|
test2_ipc_enable_polling |
160
|
|
|
|
|
|
|
test2_ipc_get_pending |
161
|
|
|
|
|
|
|
test2_ipc_set_pending |
162
|
|
|
|
|
|
|
test2_ipc_get_timeout |
163
|
|
|
|
|
|
|
test2_ipc_set_timeout |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
test2_formatter |
166
|
|
|
|
|
|
|
test2_formatters |
167
|
|
|
|
|
|
|
test2_formatter_add |
168
|
|
|
|
|
|
|
test2_formatter_set |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
test2_stdout |
171
|
|
|
|
|
|
|
test2_stderr |
172
|
|
|
|
|
|
|
test2_reset_io |
173
|
|
|
|
|
|
|
}; |
174
|
246
|
|
|
246
|
|
1860
|
BEGIN { require Exporter; our @ISA = qw(Exporter) } |
|
246
|
|
|
|
|
1038839
|
|
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
my $STACK = $INST->stack; |
177
|
|
|
|
|
|
|
my $CONTEXTS = $INST->contexts; |
178
|
|
|
|
|
|
|
my $INIT_CBS = $INST->context_init_callbacks; |
179
|
|
|
|
|
|
|
my $ACQUIRE_CBS = $INST->context_acquire_callbacks; |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
my $STDOUT = clone_io(\*STDOUT); |
182
|
|
|
|
|
|
|
my $STDERR = clone_io(\*STDERR); |
183
|
353
|
|
33
|
353
|
1
|
2465
|
sub test2_stdout { $STDOUT ||= clone_io(\*STDOUT) } |
184
|
353
|
|
33
|
353
|
1
|
2103
|
sub test2_stderr { $STDERR ||= clone_io(\*STDERR) } |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
sub test2_post_preload_reset { |
187
|
0
|
|
|
0
|
0
|
0
|
test2_reset_io(); |
188
|
0
|
|
|
|
|
0
|
$INST->post_preload_reset; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub test2_reset_io { |
192
|
0
|
|
|
0
|
1
|
0
|
$STDOUT = clone_io(\*STDOUT); |
193
|
0
|
|
|
|
|
0
|
$STDERR = clone_io(\*STDERR); |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
189
|
|
|
189
|
1
|
1215
|
sub test2_init_done { $INST->finalized } |
197
|
163
|
|
|
163
|
1
|
810
|
sub test2_load_done { $INST->loaded } |
198
|
|
|
|
|
|
|
|
199
|
403
|
|
|
403
|
0
|
1998
|
sub test2_load { $INST->load } |
200
|
1
|
|
|
1
|
0
|
13
|
sub test2_start_preload { $ENV{T2_IN_PRELOAD} = 1; $INST->start_preload } |
|
1
|
|
|
|
|
6
|
|
201
|
1
|
|
|
1
|
0
|
11
|
sub test2_stop_preload { $ENV{T2_IN_PRELOAD} = 0; $INST->stop_preload } |
|
1
|
|
|
|
|
6
|
|
202
|
1270
|
|
|
1270
|
0
|
4917
|
sub test2_in_preload { $INST->preload } |
203
|
|
|
|
|
|
|
|
204
|
1
|
|
|
1
|
0
|
6
|
sub test2_pid { $INST->pid } |
205
|
1
|
|
|
1
|
0
|
6
|
sub test2_tid { $INST->tid } |
206
|
359
|
|
|
359
|
1
|
1777
|
sub test2_stack { $INST->stack } |
207
|
2
|
|
|
2
|
1
|
22
|
sub test2_ipc_wait_enable { $INST->set_no_wait(0) } |
208
|
1
|
|
|
1
|
1
|
5
|
sub test2_ipc_wait_disable { $INST->set_no_wait(1) } |
209
|
3
|
|
|
3
|
1
|
9
|
sub test2_ipc_wait_enabled { !$INST->no_wait } |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub test2_is_testing_done { |
212
|
|
|
|
|
|
|
# No instance? VERY DONE! |
213
|
2
|
50
|
|
2
|
1
|
22
|
return 1 unless $INST; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# No stack? tests must be done, it is created pretty early |
216
|
2
|
50
|
|
|
|
20
|
my $stack = $INST->stack or return 1; |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Nothing on the stack, no root hub yet, likely have not started testing |
219
|
2
|
50
|
|
|
|
6
|
return 0 unless @$stack; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Stack has a slot for the root hub (see above) but it is undefined, likely |
222
|
|
|
|
|
|
|
# garbage collected, test is done |
223
|
2
|
50
|
|
|
|
8
|
my $root_hub = $stack->[0] or return 1; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# If the root hub is ended than testing is done. |
226
|
2
|
100
|
|
|
|
7
|
return 1 if $root_hub->ended; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Looks like we are still testing! |
229
|
1
|
|
|
|
|
6
|
return 0; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub test2_no_wait { |
233
|
5
|
100
|
|
5
|
1
|
23
|
$INST->set_no_wait(@_) if @_; |
234
|
5
|
|
|
|
|
13
|
$INST->no_wait; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub test2_add_callback_testing_done { |
238
|
0
|
|
|
0
|
1
|
0
|
my $cb = shift; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
test2_add_callback_post_load(sub { |
241
|
0
|
|
|
0
|
|
0
|
my $stack = test2_stack(); |
242
|
0
|
|
|
|
|
0
|
$stack->top; # Insure we have a hub |
243
|
0
|
|
|
|
|
0
|
my ($hub) = Test2::API::test2_stack->all; |
244
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
0
|
$hub->set_active(1); |
246
|
|
|
|
|
|
|
|
247
|
0
|
|
|
|
|
0
|
$hub->follow_up($cb); |
248
|
0
|
|
|
|
|
0
|
}); |
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
0
|
return; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
3
|
|
|
3
|
1
|
26
|
sub test2_add_callback_context_acquire { $INST->add_context_acquire_callback(@_) } |
254
|
162
|
|
|
162
|
0
|
984
|
sub test2_add_callback_context_aquire { $INST->add_context_acquire_callback(@_) } |
255
|
3
|
|
|
3
|
1
|
21
|
sub test2_add_callback_context_init { $INST->add_context_init_callback(@_) } |
256
|
3
|
|
|
3
|
1
|
22
|
sub test2_add_callback_context_release { $INST->add_context_release_callback(@_) } |
257
|
165
|
|
|
165
|
1
|
952
|
sub test2_add_callback_exit { $INST->add_exit_callback(@_) } |
258
|
165
|
|
|
165
|
1
|
1026
|
sub test2_add_callback_post_load { $INST->add_post_load_callback(@_) } |
259
|
2
|
|
|
2
|
1
|
32
|
sub test2_add_callback_pre_subtest { $INST->add_pre_subtest_callback(@_) } |
260
|
0
|
|
|
0
|
0
|
0
|
sub test2_list_context_aquire_callbacks { @{$INST->context_acquire_callbacks} } |
|
0
|
|
|
|
|
0
|
|
261
|
2
|
|
|
2
|
1
|
17
|
sub test2_list_context_acquire_callbacks { @{$INST->context_acquire_callbacks} } |
|
2
|
|
|
|
|
8
|
|
262
|
2
|
|
|
2
|
1
|
10
|
sub test2_list_context_init_callbacks { @{$INST->context_init_callbacks} } |
|
2
|
|
|
|
|
55
|
|
263
|
2
|
|
|
2
|
1
|
25
|
sub test2_list_context_release_callbacks { @{$INST->context_release_callbacks} } |
|
2
|
|
|
|
|
10
|
|
264
|
2
|
|
|
2
|
1
|
10
|
sub test2_list_exit_callbacks { @{$INST->exit_callbacks} } |
|
2
|
|
|
|
|
10
|
|
265
|
2
|
|
|
2
|
1
|
15
|
sub test2_list_post_load_callbacks { @{$INST->post_load_callbacks} } |
|
2
|
|
|
|
|
10
|
|
266
|
262
|
|
|
262
|
1
|
400
|
sub test2_list_pre_subtest_callbacks { @{$INST->pre_subtest_callbacks} } |
|
262
|
|
|
|
|
889
|
|
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub test2_add_uuid_via { |
269
|
1
|
50
|
|
1
|
1
|
16
|
$INST->set_add_uuid_via(@_) if @_; |
270
|
1
|
|
|
|
|
3
|
$INST->add_uuid_via(); |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
430
|
|
|
430
|
1
|
2364
|
sub test2_ipc { $INST->ipc } |
274
|
188
|
|
|
188
|
1
|
1048
|
sub test2_has_ipc { $INST->has_ipc } |
275
|
2
|
|
|
2
|
1
|
180
|
sub test2_ipc_disable { $INST->ipc_disable } |
276
|
3
|
|
|
3
|
0
|
32
|
sub test2_ipc_disabled { $INST->ipc_disabled } |
277
|
5
|
|
|
5
|
1
|
51
|
sub test2_ipc_add_driver { $INST->add_ipc_driver(@_) } |
278
|
6
|
|
|
6
|
1
|
33
|
sub test2_ipc_drivers { @{$INST->ipc_drivers} } |
|
6
|
|
|
|
|
30
|
|
279
|
3
|
|
|
3
|
1
|
10
|
sub test2_ipc_polling { $INST->ipc_polling } |
280
|
1
|
|
|
1
|
1
|
6
|
sub test2_ipc_enable_polling { $INST->enable_ipc_polling } |
281
|
1
|
|
|
1
|
1
|
5
|
sub test2_ipc_disable_polling { $INST->disable_ipc_polling } |
282
|
0
|
|
|
0
|
1
|
0
|
sub test2_ipc_get_pending { $INST->get_ipc_pending } |
283
|
35
|
|
|
35
|
1
|
340
|
sub test2_ipc_set_pending { $INST->set_ipc_pending(@_) } |
284
|
2
|
|
|
2
|
1
|
10
|
sub test2_ipc_set_timeout { $INST->set_ipc_timeout(@_) } |
285
|
4
|
|
|
4
|
1
|
24
|
sub test2_ipc_get_timeout { $INST->ipc_timeout() } |
286
|
0
|
|
|
0
|
1
|
0
|
sub test2_ipc_enable_shm { 0 } |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
sub test2_formatter { |
289
|
267
|
100
|
66
|
267
|
1
|
1974
|
if ($ENV{T2_FORMATTER} && $ENV{T2_FORMATTER} =~ m/^(\+)?(.*)$/) { |
290
|
18
|
50
|
|
|
|
145
|
my $formatter = $1 ? $2 : "Test2::Formatter::$2"; |
291
|
18
|
|
|
|
|
178
|
my $file = pkg_to_file($formatter); |
292
|
18
|
|
|
|
|
87
|
require $file; |
293
|
18
|
|
|
|
|
232
|
return $formatter; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
249
|
|
|
|
|
1540
|
return $INST->formatter; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
0
|
|
|
0
|
1
|
0
|
sub test2_formatters { @{$INST->formatters} } |
|
0
|
|
|
|
|
0
|
|
300
|
162
|
|
|
162
|
1
|
1139
|
sub test2_formatter_add { $INST->add_formatter(@_) } |
301
|
|
|
|
|
|
|
sub test2_formatter_set { |
302
|
2
|
|
|
2
|
1
|
18
|
my ($formatter) = @_; |
303
|
2
|
100
|
|
|
|
97
|
croak "No formatter specified" unless $formatter; |
304
|
1
|
50
|
|
|
|
6
|
croak "Global Formatter already set" if $INST->formatter_set; |
305
|
0
|
|
|
|
|
0
|
$INST->set_formatter($formatter); |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# Private, for use in Test2::API::Context |
309
|
246
|
|
|
246
|
|
1145
|
sub _contexts_ref { $INST->contexts } |
310
|
1
|
|
|
1
|
|
10
|
sub _context_acquire_callbacks_ref { $INST->context_acquire_callbacks } |
311
|
1
|
|
|
1
|
|
12
|
sub _context_init_callbacks_ref { $INST->context_init_callbacks } |
312
|
247
|
|
|
247
|
|
1529
|
sub _context_release_callbacks_ref { $INST->context_release_callbacks } |
313
|
491
|
|
|
491
|
|
2106
|
sub _add_uuid_via_ref { \($INST->{Test2::API::Instance::ADD_UUID_VIA()}) } |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# Private, for use in Test2::IPC |
316
|
0
|
|
|
0
|
|
0
|
sub _set_ipc { $INST->set_ipc(@_) } |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub context_do(&;@) { |
319
|
5
|
|
|
5
|
1
|
64
|
my $code = shift; |
320
|
5
|
|
|
|
|
14
|
my @args = @_; |
321
|
|
|
|
|
|
|
|
322
|
5
|
|
|
|
|
13
|
my $ctx = context(level => 1); |
323
|
|
|
|
|
|
|
|
324
|
5
|
|
|
|
|
10
|
my $want = wantarray; |
325
|
|
|
|
|
|
|
|
326
|
5
|
|
|
|
|
10
|
my @out; |
327
|
5
|
|
|
|
|
19
|
my $ok = eval { |
328
|
5
|
100
|
|
|
|
33
|
$want ? @out = $code->($ctx, @args) : |
|
|
100
|
|
|
|
|
|
329
|
|
|
|
|
|
|
defined($want) ? $out[0] = $code->($ctx, @args) : |
330
|
|
|
|
|
|
|
$code->($ctx, @args) ; |
331
|
3
|
|
|
|
|
50
|
1; |
332
|
|
|
|
|
|
|
}; |
333
|
5
|
|
|
|
|
28
|
my $err = $@; |
334
|
|
|
|
|
|
|
|
335
|
5
|
|
|
|
|
19
|
$ctx->release; |
336
|
|
|
|
|
|
|
|
337
|
5
|
100
|
|
|
|
23
|
die $err unless $ok; |
338
|
|
|
|
|
|
|
|
339
|
3
|
100
|
|
|
|
10
|
return @out if $want; |
340
|
2
|
100
|
|
|
|
8
|
return $out[0] if defined $want; |
341
|
1
|
|
|
|
|
4
|
return; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub no_context(&;$) { |
345
|
3
|
|
|
3
|
1
|
9
|
my ($code, $hid) = @_; |
346
|
3
|
|
66
|
|
|
14
|
$hid ||= $STACK->top->hid; |
347
|
|
|
|
|
|
|
|
348
|
3
|
|
|
|
|
8
|
my $ctx = $CONTEXTS->{$hid}; |
349
|
3
|
|
|
|
|
9
|
delete $CONTEXTS->{$hid}; |
350
|
3
|
|
|
|
|
5
|
my $ok = eval { $code->(); 1 }; |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
9
|
|
351
|
3
|
|
|
|
|
7
|
my $err = $@; |
352
|
|
|
|
|
|
|
|
353
|
3
|
|
|
|
|
18
|
$CONTEXTS->{$hid} = $ctx; |
354
|
3
|
|
|
|
|
15
|
weaken($CONTEXTS->{$hid}); |
355
|
|
|
|
|
|
|
|
356
|
3
|
50
|
|
|
|
7
|
die $err unless $ok; |
357
|
|
|
|
|
|
|
|
358
|
3
|
|
|
|
|
10
|
return; |
359
|
|
|
|
|
|
|
}; |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
my $UUID_VIA = _add_uuid_via_ref(); |
362
|
|
|
|
|
|
|
sub context { |
363
|
|
|
|
|
|
|
# We need to grab these before anything else to ensure they are not |
364
|
|
|
|
|
|
|
# changed. |
365
|
13362
|
|
|
13362
|
1
|
111233
|
my ($errno, $eval_error, $child_error, $extended_error) = (0 + $!, $@, $?, $^E); |
366
|
|
|
|
|
|
|
|
367
|
13362
|
|
|
|
|
64492
|
my %params = (level => 0, wrapped => 0, @_); |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
# If something is getting a context then the sync system needs to be |
370
|
|
|
|
|
|
|
# considered loaded... |
371
|
13362
|
100
|
|
|
|
39201
|
$INST->load unless $INST->{loaded}; |
372
|
|
|
|
|
|
|
|
373
|
13362
|
100
|
|
|
|
28080
|
croak "context() called, but return value is ignored" |
374
|
|
|
|
|
|
|
unless defined wantarray; |
375
|
|
|
|
|
|
|
|
376
|
13361
|
|
66
|
|
|
34812
|
my $stack = $params{stack} || $STACK; |
377
|
13361
|
|
66
|
|
|
56021
|
my $hub = $params{hub} || (@$stack ? $stack->[-1] : $stack->top); |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# Catch an edge case where we try to get context after the root hub has |
380
|
|
|
|
|
|
|
# been garbage collected resulting in a stack that has a single undef |
381
|
|
|
|
|
|
|
# hub |
382
|
13361
|
50
|
33
|
|
|
42038
|
if (!$hub && !exists($params{hub}) && @$stack) { |
|
|
|
33
|
|
|
|
|
383
|
0
|
|
|
|
|
0
|
my $msg = Carp::longmess("Attempt to get Test2 context after testing has completed (did you attempt a testing event after done_testing?)"); |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
# The error message is usually masked by the global destruction, so we have to print to STDER |
386
|
0
|
|
|
|
|
0
|
print STDERR $msg; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# Make sure this is a failure, we are probably already in END, so set $? to change the exit code |
389
|
0
|
|
|
|
|
0
|
$? = 1; |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
# Now we actually die to interrupt the program flow and avoid undefined his warnings |
392
|
0
|
|
|
|
|
0
|
die $msg; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
13361
|
|
|
|
|
24200
|
my $hid = $hub->{hid}; |
396
|
13361
|
|
|
|
|
22469
|
my $current = $CONTEXTS->{$hid}; |
397
|
|
|
|
|
|
|
|
398
|
13361
|
|
|
|
|
48272
|
$_->(\%params) for @$ACQUIRE_CBS; |
399
|
13361
|
100
|
|
|
|
27604
|
map $_->(\%params), @{$hub->{_context_acquire}} if $hub->{_context_acquire}; |
|
88
|
|
|
|
|
178
|
|
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
# This is for https://github.com/Test-More/test-more/issues/16 |
402
|
|
|
|
|
|
|
# and https://rt.perl.org/Public/Bug/Display.html?id=127774 |
403
|
13361
|
|
50
|
|
|
41792
|
my $phase = ${^GLOBAL_PHASE} || 'NA'; |
404
|
13361
|
|
66
|
|
|
61326
|
my $end_phase = $ENDING || $phase eq 'END' || $phase eq 'DESTRUCT'; |
405
|
|
|
|
|
|
|
|
406
|
13361
|
|
|
|
|
21950
|
my $level = 1 + $params{level}; |
407
|
13361
|
100
|
|
|
|
107306
|
my ($pkg, $file, $line, $sub, @other) = $end_phase ? caller(0) : caller($level); |
408
|
13361
|
100
|
66
|
|
|
39145
|
unless ($pkg || $end_phase) { |
409
|
515
|
100
|
|
|
|
1459
|
confess "Could not find context at depth $level" unless $params{fudge}; |
410
|
514
|
|
66
|
|
|
6043
|
($pkg, $file, $line, $sub, @other) = caller(--$level) while ($level >= 0 && !$pkg); |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
13360
|
|
|
|
|
19596
|
my $depth = $level; |
414
|
13360
|
|
100
|
|
|
138613
|
$depth++ while DO_DEPTH_CHECK && !$end_phase && (!$current || $depth <= $current->{_depth} + $params{wrapped}) && caller($depth + 1); |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
415
|
13360
|
|
|
|
|
22579
|
$depth -= $params{wrapped}; |
416
|
13360
|
|
100
|
|
|
50205
|
my $depth_ok = !DO_DEPTH_CHECK || $end_phase || !$current || $current->{_depth} < $depth; |
417
|
|
|
|
|
|
|
|
418
|
13360
|
100
|
100
|
|
|
35045
|
if ($current && $params{on_release} && $depth_ok) { |
|
|
|
66
|
|
|
|
|
419
|
1
|
|
50
|
|
|
3
|
$current->{_on_release} ||= []; |
420
|
1
|
|
|
|
|
2
|
push @{$current->{_on_release}} => $params{on_release}; |
|
1
|
|
|
|
|
3
|
|
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
# I know this is ugly.... |
424
|
13360
|
100
|
50
|
|
|
109981
|
($!, $@, $?, $^E) = ($errno, $eval_error, $child_error, $extended_error) and return bless( |
|
|
|
100
|
|
|
|
|
425
|
|
|
|
|
|
|
{ |
426
|
|
|
|
|
|
|
%$current, |
427
|
|
|
|
|
|
|
_is_canon => undef, |
428
|
|
|
|
|
|
|
errno => $errno, |
429
|
|
|
|
|
|
|
eval_error => $eval_error, |
430
|
|
|
|
|
|
|
child_error => $child_error, |
431
|
|
|
|
|
|
|
_is_spawn => [$pkg, $file, $line, $sub], |
432
|
|
|
|
|
|
|
}, |
433
|
|
|
|
|
|
|
'Test2::API::Context' |
434
|
|
|
|
|
|
|
) if $current && $depth_ok; |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# Handle error condition of bad level |
437
|
8336
|
100
|
|
|
|
15662
|
if ($current) { |
438
|
3
|
100
|
|
|
|
9
|
unless (${$current->{_aborted}}) { |
|
3
|
|
|
|
|
23
|
|
439
|
|
|
|
|
|
|
_canon_error($current, [$pkg, $file, $line, $sub, $depth]) |
440
|
2
|
50
|
|
|
|
8
|
unless $current->{_is_canon}; |
441
|
|
|
|
|
|
|
|
442
|
2
|
50
|
|
|
|
14
|
_depth_error($current, [$pkg, $file, $line, $sub, $depth]) |
443
|
|
|
|
|
|
|
unless $depth_ok; |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
3
|
50
|
|
|
|
49
|
$current->release if $current->{_is_canon}; |
447
|
|
|
|
|
|
|
|
448
|
3
|
|
|
|
|
8
|
delete $CONTEXTS->{$hid}; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
# Directly bless the object here, calling new is a noticeable performance |
452
|
|
|
|
|
|
|
# hit with how often this needs to be called. |
453
|
|
|
|
|
|
|
my $trace = bless( |
454
|
|
|
|
|
|
|
{ |
455
|
|
|
|
|
|
|
frame => [$pkg, $file, $line, $sub], |
456
|
|
|
|
|
|
|
pid => $$, |
457
|
|
|
|
|
|
|
tid => get_tid(), |
458
|
|
|
|
|
|
|
cid => gen_uid(), |
459
|
|
|
|
|
|
|
hid => $hid, |
460
|
|
|
|
|
|
|
nested => $hub->{nested}, |
461
|
|
|
|
|
|
|
buffered => $hub->{buffered}, |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
full_caller => [$pkg, $file, $line, $sub, @other], |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
$$UUID_VIA ? ( |
466
|
|
|
|
|
|
|
huuid => $hub->{uuid}, |
467
|
8336
|
100
|
|
|
|
38381
|
uuid => ${$UUID_VIA}->('context'), |
|
43
|
|
|
|
|
106
|
|
468
|
|
|
|
|
|
|
) : (), |
469
|
|
|
|
|
|
|
}, |
470
|
|
|
|
|
|
|
'Test2::EventFacet::Trace' |
471
|
|
|
|
|
|
|
); |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# Directly bless the object here, calling new is a noticeable performance |
474
|
|
|
|
|
|
|
# hit with how often this needs to be called. |
475
|
8336
|
|
|
|
|
18365
|
my $aborted = 0; |
476
|
|
|
|
|
|
|
$current = bless( |
477
|
|
|
|
|
|
|
{ |
478
|
|
|
|
|
|
|
_aborted => \$aborted, |
479
|
|
|
|
|
|
|
stack => $stack, |
480
|
|
|
|
|
|
|
hub => $hub, |
481
|
|
|
|
|
|
|
trace => $trace, |
482
|
|
|
|
|
|
|
_is_canon => 1, |
483
|
|
|
|
|
|
|
_depth => $depth, |
484
|
|
|
|
|
|
|
errno => $errno, |
485
|
|
|
|
|
|
|
eval_error => $eval_error, |
486
|
|
|
|
|
|
|
child_error => $child_error, |
487
|
8336
|
100
|
|
|
|
60028
|
$params{on_release} ? (_on_release => [$params{on_release}]) : (), |
488
|
|
|
|
|
|
|
}, |
489
|
|
|
|
|
|
|
'Test2::API::Context' |
490
|
|
|
|
|
|
|
); |
491
|
|
|
|
|
|
|
|
492
|
8336
|
|
|
|
|
21691
|
$CONTEXTS->{$hid} = $current; |
493
|
8336
|
|
|
|
|
32526
|
weaken($CONTEXTS->{$hid}); |
494
|
|
|
|
|
|
|
|
495
|
8336
|
|
|
|
|
18719
|
$_->($current) for @$INIT_CBS; |
496
|
8336
|
100
|
|
|
|
19442
|
map $_->($current), @{$hub->{_context_init}} if $hub->{_context_init}; |
|
49
|
|
|
|
|
87
|
|
497
|
|
|
|
|
|
|
|
498
|
8336
|
100
|
|
|
|
16596
|
$params{on_init}->($current) if $params{on_init}; |
499
|
|
|
|
|
|
|
|
500
|
8336
|
|
|
|
|
37089
|
($!, $@, $?, $^E) = ($errno, $eval_error, $child_error, $extended_error); |
501
|
|
|
|
|
|
|
|
502
|
8336
|
|
|
|
|
40683
|
return $current; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub _depth_error { |
506
|
2
|
|
|
2
|
|
9
|
_existing_error(@_, <<" EOT"); |
507
|
|
|
|
|
|
|
context() was called to retrieve an existing context, however the existing |
508
|
|
|
|
|
|
|
context was created in a stack frame at the same, or deeper level. This usually |
509
|
|
|
|
|
|
|
means that a tool failed to release the context when it was finished. |
510
|
|
|
|
|
|
|
EOT |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
sub _canon_error { |
514
|
0
|
|
|
0
|
|
0
|
_existing_error(@_, <<" EOT"); |
515
|
|
|
|
|
|
|
context() was called to retrieve an existing context, however the existing |
516
|
|
|
|
|
|
|
context has an invalid internal state (!_canon_count). This should not normally |
517
|
|
|
|
|
|
|
happen unless something is mucking about with internals... |
518
|
|
|
|
|
|
|
EOT |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub _existing_error { |
522
|
2
|
|
|
2
|
|
8
|
my ($ctx, $details, $msg) = @_; |
523
|
2
|
|
|
|
|
8
|
my ($pkg, $file, $line, $sub, $depth) = @$details; |
524
|
|
|
|
|
|
|
|
525
|
2
|
|
|
|
|
10
|
my $oldframe = $ctx->{trace}->frame; |
526
|
2
|
|
|
|
|
4
|
my $olddepth = $ctx->{_depth}; |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# Older versions of Carp do not export longmess() function, so it needs to be called with package name |
529
|
2
|
|
|
|
|
213
|
my $mess = Carp::longmess(); |
530
|
|
|
|
|
|
|
|
531
|
2
|
|
|
|
|
474
|
warn <<" EOT"; |
532
|
|
|
|
|
|
|
$msg |
533
|
|
|
|
|
|
|
Old context details: |
534
|
|
|
|
|
|
|
File: $oldframe->[1] |
535
|
|
|
|
|
|
|
Line: $oldframe->[2] |
536
|
|
|
|
|
|
|
Tool: $oldframe->[3] |
537
|
|
|
|
|
|
|
Depth: $olddepth |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
New context details: |
540
|
|
|
|
|
|
|
File: $file |
541
|
|
|
|
|
|
|
Line: $line |
542
|
|
|
|
|
|
|
Tool: $sub |
543
|
|
|
|
|
|
|
Depth: $depth |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
Trace: $mess |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
Removing the old context and creating a new one... |
548
|
|
|
|
|
|
|
EOT |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub release($;$) { |
552
|
3186
|
|
|
3186
|
1
|
10323
|
$_[0]->release; |
553
|
3186
|
|
|
|
|
10187
|
return $_[1]; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
sub intercept(&) { |
557
|
62
|
|
|
62
|
1
|
569
|
my $code = shift; |
558
|
62
|
|
|
|
|
205
|
my $ctx = context(); |
559
|
|
|
|
|
|
|
|
560
|
62
|
|
|
|
|
300
|
my $events = _intercept($code, deep => 0); |
561
|
|
|
|
|
|
|
|
562
|
60
|
|
|
|
|
326
|
$ctx->release; |
563
|
|
|
|
|
|
|
|
564
|
60
|
|
|
|
|
412
|
return $events; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub intercept_deep(&) { |
568
|
2
|
|
|
2
|
0
|
20
|
my $code = shift; |
569
|
2
|
|
|
|
|
5
|
my $ctx = context(); |
570
|
|
|
|
|
|
|
|
571
|
2
|
|
|
|
|
7
|
my $events = _intercept($code, deep => 1); |
572
|
|
|
|
|
|
|
|
573
|
2
|
|
|
|
|
7
|
$ctx->release; |
574
|
|
|
|
|
|
|
|
575
|
2
|
|
|
|
|
6
|
return $events; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
sub _intercept { |
579
|
64
|
|
|
64
|
|
148
|
my $code = shift; |
580
|
64
|
|
|
|
|
213
|
my %params = @_; |
581
|
64
|
|
|
|
|
161
|
my $ctx = context(); |
582
|
|
|
|
|
|
|
|
583
|
64
|
|
|
|
|
239
|
my $ipc; |
584
|
64
|
100
|
|
|
|
283
|
if (my $global_ipc = test2_ipc()) { |
585
|
13
|
|
|
|
|
79
|
my $driver = blessed($global_ipc); |
586
|
13
|
|
|
|
|
92
|
$ipc = $driver->new; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
64
|
|
|
|
|
674
|
my $hub = Test2::Hub::Interceptor->new( |
590
|
|
|
|
|
|
|
ipc => $ipc, |
591
|
|
|
|
|
|
|
no_ending => 1, |
592
|
|
|
|
|
|
|
); |
593
|
|
|
|
|
|
|
|
594
|
64
|
|
|
|
|
146
|
my @events; |
595
|
64
|
|
|
168
|
|
716
|
$hub->listen(sub { push @events => $_[1] }, inherit => $params{deep}); |
|
168
|
|
|
|
|
541
|
|
596
|
|
|
|
|
|
|
|
597
|
64
|
|
|
|
|
323
|
$ctx->stack->top; # Make sure there is a top hub before we begin. |
598
|
64
|
|
|
|
|
227
|
$ctx->stack->push($hub); |
599
|
|
|
|
|
|
|
|
600
|
64
|
|
|
|
|
255
|
my $trace = $ctx->trace; |
601
|
64
|
|
|
|
|
165
|
my $state = {}; |
602
|
64
|
|
|
|
|
305
|
$hub->clean_inherited(trace => $trace, state => $state); |
603
|
|
|
|
|
|
|
|
604
|
64
|
|
|
|
|
191
|
my ($ok, $err) = (1, undef); |
605
|
|
|
|
|
|
|
T2_SUBTEST_WRAPPER: { |
606
|
|
|
|
|
|
|
# Do not use 'try' cause it localizes __DIE__ |
607
|
64
|
|
|
|
|
164
|
$ok = eval { $code->(hub => $hub, context => $ctx->snapshot); 1 }; |
|
64
|
|
|
|
|
130
|
|
|
64
|
|
|
|
|
323
|
|
|
54
|
|
|
|
|
196
|
|
608
|
55
|
|
|
|
|
171
|
$err = $@; |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
# They might have done 'BEGIN { skip_all => "whatever" }' |
611
|
55
|
50
|
66
|
|
|
474
|
if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && $err->isa('Test2::Hub::Interceptor::Terminator'))) { |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
612
|
0
|
|
|
|
|
0
|
$ok = 1; |
613
|
0
|
|
|
|
|
0
|
$err = undef; |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
63
|
|
|
|
|
379
|
$hub->cull; |
618
|
63
|
|
|
|
|
353
|
$ctx->stack->pop($hub); |
619
|
|
|
|
|
|
|
|
620
|
63
|
|
|
|
|
321
|
$hub->restore_inherited(trace => $trace, state => $state); |
621
|
|
|
|
|
|
|
|
622
|
63
|
|
|
|
|
259
|
$ctx->release; |
623
|
|
|
|
|
|
|
|
624
|
63
|
100
|
|
|
|
238
|
die $err unless $ok; |
625
|
|
|
|
|
|
|
|
626
|
62
|
100
|
66
|
|
|
552
|
$hub->finalize($trace, 1) |
|
|
|
100
|
|
|
|
|
627
|
|
|
|
|
|
|
if $ok |
628
|
|
|
|
|
|
|
&& !$hub->no_ending |
629
|
|
|
|
|
|
|
&& !$hub->ended; |
630
|
|
|
|
|
|
|
|
631
|
62
|
|
|
|
|
18870
|
require Test2::API::InterceptResult; |
632
|
62
|
|
|
|
|
504
|
return Test2::API::InterceptResult->new_from_ref(\@events); |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
sub run_subtest { |
636
|
122
|
|
|
122
|
1
|
596
|
my ($name, $code, $params, @args) = @_; |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
$_->($name,$code,@args) |
639
|
122
|
|
|
|
|
370
|
for Test2::API::test2_list_pre_subtest_callbacks(); |
640
|
|
|
|
|
|
|
|
641
|
122
|
100
|
|
|
|
499
|
$params = {buffered => $params} unless ref $params; |
642
|
122
|
|
|
|
|
297
|
my $inherit_trace = delete $params->{inherit_trace}; |
643
|
|
|
|
|
|
|
|
644
|
122
|
|
|
|
|
329
|
my $ctx = context(); |
645
|
|
|
|
|
|
|
|
646
|
122
|
|
|
|
|
545
|
my $parent = $ctx->hub; |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
# If a parent is buffered then the child must be as well. |
649
|
122
|
|
100
|
|
|
438
|
my $buffered = $params->{buffered} || $parent->{buffered}; |
650
|
|
|
|
|
|
|
|
651
|
122
|
100
|
|
|
|
358
|
$ctx->note($name) unless $buffered; |
652
|
|
|
|
|
|
|
|
653
|
122
|
|
33
|
|
|
355
|
my $stack = $ctx->stack || $STACK; |
654
|
122
|
|
|
|
|
680
|
my $hub = $stack->new_hub( |
655
|
|
|
|
|
|
|
class => 'Test2::Hub::Subtest', |
656
|
|
|
|
|
|
|
%$params, |
657
|
|
|
|
|
|
|
buffered => $buffered, |
658
|
|
|
|
|
|
|
); |
659
|
|
|
|
|
|
|
|
660
|
122
|
|
|
|
|
242
|
my @events; |
661
|
122
|
|
|
830
|
|
948
|
$hub->listen(sub { push @events => $_[1] }); |
|
830
|
|
|
|
|
2351
|
|
662
|
|
|
|
|
|
|
|
663
|
122
|
100
|
|
|
|
333
|
if ($buffered) { |
664
|
106
|
100
|
|
|
|
404
|
if (my $format = $hub->format) { |
665
|
80
|
100
|
|
|
|
638
|
my $hide = $format->can('hide_buffered') ? $format->hide_buffered : 1; |
666
|
80
|
100
|
|
|
|
312
|
$hub->format(undef) if $hide; |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
122
|
100
|
|
|
|
310
|
if ($inherit_trace) { |
671
|
5
|
|
|
|
|
7
|
my $orig = $code; |
672
|
|
|
|
|
|
|
$code = sub { |
673
|
5
|
|
|
5
|
|
16
|
my $base_trace = $ctx->trace; |
674
|
5
|
|
|
|
|
25
|
my $trace = $base_trace->snapshot(nested => 1 + $base_trace->nested); |
675
|
5
|
|
|
|
|
20
|
my $st_ctx = Test2::API::Context->new( |
676
|
|
|
|
|
|
|
trace => $trace, |
677
|
|
|
|
|
|
|
hub => $hub, |
678
|
|
|
|
|
|
|
); |
679
|
5
|
|
|
|
|
19
|
$st_ctx->do_in_context($orig, @args); |
680
|
5
|
|
|
|
|
36
|
}; |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
122
|
|
|
|
|
251
|
my ($ok, $err, $finished); |
684
|
|
|
|
|
|
|
T2_SUBTEST_WRAPPER: { |
685
|
|
|
|
|
|
|
# Do not use 'try' cause it localizes __DIE__ |
686
|
122
|
|
|
|
|
222
|
$ok = eval { $code->(@args); 1 }; |
|
122
|
|
|
|
|
193
|
|
|
122
|
|
|
|
|
411
|
|
|
118
|
|
|
|
|
550
|
|
687
|
119
|
|
|
|
|
1638
|
$err = $@; |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
# They might have done 'BEGIN { skip_all => "whatever" }' |
690
|
119
|
50
|
66
|
|
|
1172
|
if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) { |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
691
|
0
|
|
|
|
|
0
|
$ok = undef; |
692
|
0
|
|
|
|
|
0
|
$err = undef; |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
else { |
695
|
119
|
|
|
|
|
294
|
$finished = 1; |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
121
|
100
|
33
|
|
|
727
|
if ($params->{no_fork}) { |
|
|
50
|
|
|
|
|
|
700
|
2
|
100
|
|
|
|
78
|
if ($$ != $ctx->trace->pid) { |
701
|
1
|
50
|
|
|
|
51
|
warn $ok ? "Forked inside subtest, but subtest never finished!\n" : $err; |
702
|
1
|
|
|
|
|
143
|
exit 255; |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
|
705
|
1
|
50
|
|
|
|
6
|
if (get_tid() != $ctx->trace->tid) { |
706
|
0
|
0
|
|
|
|
0
|
warn $ok ? "Started new thread inside subtest, but thread never finished!\n" : $err; |
707
|
0
|
|
|
|
|
0
|
exit 255; |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
elsif (!$parent->is_local && !$parent->ipc) { |
711
|
0
|
0
|
|
|
|
0
|
warn $ok ? "A new process or thread was started inside subtest, but IPC is not enabled!\n" : $err; |
712
|
0
|
|
|
|
|
0
|
exit 255; |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
|
715
|
120
|
|
|
|
|
614
|
$stack->pop($hub); |
716
|
|
|
|
|
|
|
|
717
|
120
|
|
|
|
|
409
|
my $trace = $ctx->trace; |
718
|
|
|
|
|
|
|
|
719
|
120
|
|
|
|
|
524
|
my $bailed = $hub->bailed_out; |
720
|
|
|
|
|
|
|
|
721
|
120
|
100
|
|
|
|
338
|
if (!$finished) { |
722
|
2
|
50
|
33
|
|
|
13
|
if ($bailed && !$buffered) { |
|
|
50
|
33
|
|
|
|
|
723
|
0
|
|
|
|
|
0
|
$ctx->bail($bailed->reason); |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
elsif ($bailed && $buffered) { |
726
|
2
|
|
|
|
|
4
|
$ok = 1; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
else { |
729
|
0
|
|
|
|
|
0
|
my $code = $hub->exit_code; |
730
|
0
|
|
|
|
|
0
|
$ok = !$code; |
731
|
0
|
0
|
|
|
|
0
|
$err = "Subtest ended with exit code $code" if $code; |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
120
|
50
|
33
|
|
|
675
|
$hub->finalize($trace->snapshot(huuid => $hub->uuid, hid => $hub->hid, nested => $hub->nested, buffered => $buffered), 1) |
|
|
|
33
|
|
|
|
|
736
|
|
|
|
|
|
|
if $ok |
737
|
|
|
|
|
|
|
&& !$hub->no_ending |
738
|
|
|
|
|
|
|
&& !$hub->ended; |
739
|
|
|
|
|
|
|
|
740
|
120
|
|
66
|
|
|
562
|
my $pass = $ok && $hub->is_passing; |
741
|
120
|
|
|
|
|
466
|
my $e = $ctx->build_event( |
742
|
|
|
|
|
|
|
'Subtest', |
743
|
|
|
|
|
|
|
pass => $pass, |
744
|
|
|
|
|
|
|
name => $name, |
745
|
|
|
|
|
|
|
subtest_id => $hub->id, |
746
|
|
|
|
|
|
|
subtest_uuid => $hub->uuid, |
747
|
|
|
|
|
|
|
buffered => $buffered, |
748
|
|
|
|
|
|
|
subevents => \@events, |
749
|
|
|
|
|
|
|
); |
750
|
|
|
|
|
|
|
|
751
|
120
|
|
|
|
|
640
|
my $plan_ok = $hub->check_plan; |
752
|
|
|
|
|
|
|
|
753
|
120
|
|
|
|
|
408
|
$ctx->hub->send($e); |
754
|
|
|
|
|
|
|
|
755
|
120
|
100
|
|
|
|
722
|
$ctx->failure_diag($e) unless $e->pass; |
756
|
|
|
|
|
|
|
|
757
|
120
|
50
|
|
|
|
324
|
$ctx->diag("Caught exception in subtest: $err") unless $ok; |
758
|
|
|
|
|
|
|
|
759
|
120
|
100
|
100
|
|
|
602
|
$ctx->diag("Bad subtest plan, expected " . $hub->plan . " but ran " . $hub->count) |
760
|
|
|
|
|
|
|
if defined($plan_ok) && !$plan_ok; |
761
|
|
|
|
|
|
|
|
762
|
120
|
100
|
66
|
|
|
417
|
$ctx->bail($bailed->reason) if $bailed && $buffered; |
763
|
|
|
|
|
|
|
|
764
|
118
|
|
|
|
|
491
|
$ctx->release; |
765
|
118
|
|
|
|
|
1226
|
return $pass; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
# There is a use-cycle between API and API/Context. Context needs to use some |
769
|
|
|
|
|
|
|
# API functions as the package is compiling. Test2::API::context() needs |
770
|
|
|
|
|
|
|
# Test2::API::Context to be loaded, but we cannot 'require' the module there as |
771
|
|
|
|
|
|
|
# it causes a very noticeable performance impact with how often context() is |
772
|
|
|
|
|
|
|
# called. |
773
|
|
|
|
|
|
|
require Test2::API::Context; |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
1; |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
__END__ |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=pod |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=encoding UTF-8 |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=head1 NAME |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
Test2::API - Primary interface for writing Test2 based testing tools. |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
=head1 ***INTERNALS NOTE*** |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
B<The internals of this package are subject to change at any time!> The public |
790
|
|
|
|
|
|
|
methods provided will not change in backwards-incompatible ways (once there is |
791
|
|
|
|
|
|
|
a stable release), but the underlying implementation details might. |
792
|
|
|
|
|
|
|
B<Do not break encapsulation here!> |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
Currently the implementation is to create a single instance of the |
795
|
|
|
|
|
|
|
L<Test2::API::Instance> Object. All class methods defer to the single |
796
|
|
|
|
|
|
|
instance. There is no public access to the singleton, and that is intentional. |
797
|
|
|
|
|
|
|
The class methods provided by this package provide the only functionality |
798
|
|
|
|
|
|
|
publicly exposed. |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
This is done primarily to avoid the problems Test::Builder had by exposing its |
801
|
|
|
|
|
|
|
singleton. We do not want anyone to replace this singleton, rebless it, or |
802
|
|
|
|
|
|
|
directly muck with its internals. If you need to do something and cannot |
803
|
|
|
|
|
|
|
because of the restrictions placed here, then please report it as an issue. If |
804
|
|
|
|
|
|
|
possible, we will create a way for you to implement your functionality without |
805
|
|
|
|
|
|
|
exposing things that should not be exposed. |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=head1 DESCRIPTION |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
This package exports all the functions necessary to write and/or verify testing |
810
|
|
|
|
|
|
|
tools. Using these building blocks you can begin writing test tools very |
811
|
|
|
|
|
|
|
quickly. You are also provided with tools that help you to test the tools you |
812
|
|
|
|
|
|
|
write. |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=head1 SYNOPSIS |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=head2 WRITING A TOOL |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
The C<context()> method is your primary interface into the Test2 framework. |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
package My::Ok; |
821
|
|
|
|
|
|
|
use Test2::API qw/context/; |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
our @EXPORT = qw/my_ok/; |
824
|
|
|
|
|
|
|
use base 'Exporter'; |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
# Just like ok() from Test::More |
827
|
|
|
|
|
|
|
sub my_ok($;$) { |
828
|
|
|
|
|
|
|
my ($bool, $name) = @_; |
829
|
|
|
|
|
|
|
my $ctx = context(); # Get a context |
830
|
|
|
|
|
|
|
$ctx->ok($bool, $name); |
831
|
|
|
|
|
|
|
$ctx->release; # Release the context |
832
|
|
|
|
|
|
|
return $bool; |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
See L<Test2::API::Context> for a list of methods available on the context object. |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=head2 TESTING YOUR TOOLS |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
The C<intercept { ... }> tool lets you temporarily intercept all events |
840
|
|
|
|
|
|
|
generated by the test system: |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
use Test2::API qw/intercept/; |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
use My::Ok qw/my_ok/; |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
my $events = intercept { |
847
|
|
|
|
|
|
|
# These events are not displayed |
848
|
|
|
|
|
|
|
my_ok(1, "pass"); |
849
|
|
|
|
|
|
|
my_ok(0, "fail"); |
850
|
|
|
|
|
|
|
}; |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
As of version 1.302178 this now returns an arrayref that is also an instance of |
853
|
|
|
|
|
|
|
L<Test2::API::InterceptResult>. See the L<Test2::API::InterceptResult> |
854
|
|
|
|
|
|
|
documentation for details on how to best use it. |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=head2 OTHER API FUNCTIONS |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
use Test2::API qw{ |
859
|
|
|
|
|
|
|
test2_init_done |
860
|
|
|
|
|
|
|
test2_stack |
861
|
|
|
|
|
|
|
test2_set_is_end |
862
|
|
|
|
|
|
|
test2_get_is_end |
863
|
|
|
|
|
|
|
test2_ipc |
864
|
|
|
|
|
|
|
test2_formatter_set |
865
|
|
|
|
|
|
|
test2_formatter |
866
|
|
|
|
|
|
|
test2_is_testing_done |
867
|
|
|
|
|
|
|
}; |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
my $init = test2_init_done(); |
870
|
|
|
|
|
|
|
my $stack = test2_stack(); |
871
|
|
|
|
|
|
|
my $ipc = test2_ipc(); |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
test2_formatter_set($FORMATTER) |
874
|
|
|
|
|
|
|
my $formatter = test2_formatter(); |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
... And others ... |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
=head1 MAIN API EXPORTS |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
All exports are optional. You must specify subs to import. |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
use Test2::API qw/context intercept run_subtest/; |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
This is the list of exports that are most commonly needed. If you are simply |
885
|
|
|
|
|
|
|
writing a tool, then this is probably all you need. If you need something and |
886
|
|
|
|
|
|
|
you cannot find it here, then you can also look at L</OTHER API EXPORTS>. |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
These exports lack the 'test2_' prefix because of how important/common they |
889
|
|
|
|
|
|
|
are. Exports in the L</OTHER API EXPORTS> section have the 'test2_' prefix to |
890
|
|
|
|
|
|
|
ensure they stand out. |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=head2 context(...) |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
Usage: |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=over 4 |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=item $ctx = context() |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=item $ctx = context(%params) |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
=back |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
The C<context()> function will always return the current context. If |
905
|
|
|
|
|
|
|
there is already a context active, it will be returned. If there is not an |
906
|
|
|
|
|
|
|
active context, one will be generated. When a context is generated it will |
907
|
|
|
|
|
|
|
default to using the file and line number where the currently running sub was |
908
|
|
|
|
|
|
|
called from. |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
Please see L<Test2::API::Context/"CRITICAL DETAILS"> for important rules about |
911
|
|
|
|
|
|
|
what you can and cannot do with a context once it is obtained. |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
B<Note> This function will throw an exception if you ignore the context object |
914
|
|
|
|
|
|
|
it returns. |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
B<Note> On perls 5.14+ a depth check is used to insure there are no context |
917
|
|
|
|
|
|
|
leaks. This cannot be safely done on older perls due to |
918
|
|
|
|
|
|
|
L<https://rt.perl.org/Public/Bug/Display.html?id=127774> |
919
|
|
|
|
|
|
|
You can forcefully enable it either by setting C<$ENV{T2_CHECK_DEPTH} = 1> or |
920
|
|
|
|
|
|
|
C<$Test2::API::DO_DEPTH_CHECK = 1> B<BEFORE> loading L<Test2::API>. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=head3 OPTIONAL PARAMETERS |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
All parameters to C<context> are optional. |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
=over 4 |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=item level => $int |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
If you must obtain a context in a sub deeper than your entry point you can use |
931
|
|
|
|
|
|
|
this to tell it how many EXTRA stack frames to look back. If this option is not |
932
|
|
|
|
|
|
|
provided the default of C<0> is used. |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
sub third_party_tool { |
935
|
|
|
|
|
|
|
my $sub = shift; |
936
|
|
|
|
|
|
|
... # Does not obtain a context |
937
|
|
|
|
|
|
|
$sub->(); |
938
|
|
|
|
|
|
|
... |
939
|
|
|
|
|
|
|
} |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
third_party_tool(sub { |
942
|
|
|
|
|
|
|
my $ctx = context(level => 1); |
943
|
|
|
|
|
|
|
... |
944
|
|
|
|
|
|
|
$ctx->release; |
945
|
|
|
|
|
|
|
}); |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=item wrapped => $int |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
Use this if you need to write your own tool that wraps a call to C<context()> |
950
|
|
|
|
|
|
|
with the intent that it should return a context object. |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
sub my_context { |
953
|
|
|
|
|
|
|
my %params = ( wrapped => 0, @_ ); |
954
|
|
|
|
|
|
|
$params{wrapped}++; |
955
|
|
|
|
|
|
|
my $ctx = context(%params); |
956
|
|
|
|
|
|
|
... |
957
|
|
|
|
|
|
|
return $ctx; |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
sub my_tool { |
961
|
|
|
|
|
|
|
my $ctx = my_context(); |
962
|
|
|
|
|
|
|
... |
963
|
|
|
|
|
|
|
$ctx->release; |
964
|
|
|
|
|
|
|
} |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
If you do not do this, then tools you call that also check for a context will |
967
|
|
|
|
|
|
|
notice that the context they grabbed was created at the same stack depth, which |
968
|
|
|
|
|
|
|
will trigger protective measures that warn you and destroy the existing |
969
|
|
|
|
|
|
|
context. |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=item stack => $stack |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
Normally C<context()> looks at the global hub stack. If you are maintaining |
974
|
|
|
|
|
|
|
your own L<Test2::API::Stack> instance you may pass it in to be used |
975
|
|
|
|
|
|
|
instead of the global one. |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
=item hub => $hub |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
Use this parameter if you want to obtain the context for a specific hub instead |
980
|
|
|
|
|
|
|
of whatever one happens to be at the top of the stack. |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=item on_init => sub { ... } |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
This lets you provide a callback sub that will be called B<ONLY> if your call |
985
|
|
|
|
|
|
|
to C<context()> generated a new context. The callback B<WILL NOT> be called if |
986
|
|
|
|
|
|
|
C<context()> is returning an existing context. The only argument passed into |
987
|
|
|
|
|
|
|
the callback will be the context object itself. |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
sub foo { |
990
|
|
|
|
|
|
|
my $ctx = context(on_init => sub { 'will run' }); |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
my $inner = sub { |
993
|
|
|
|
|
|
|
# This callback is not run since we are getting the existing |
994
|
|
|
|
|
|
|
# context from our parent sub. |
995
|
|
|
|
|
|
|
my $ctx = context(on_init => sub { 'will NOT run' }); |
996
|
|
|
|
|
|
|
$ctx->release; |
997
|
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
|
$inner->(); |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
$ctx->release; |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
=item on_release => sub { ... } |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
This lets you provide a callback sub that will be called when the context |
1006
|
|
|
|
|
|
|
instance is released. This callback will be added to the returned context even |
1007
|
|
|
|
|
|
|
if an existing context is returned. If multiple calls to context add callbacks, |
1008
|
|
|
|
|
|
|
then all will be called in reverse order when the context is finally released. |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
sub foo { |
1011
|
|
|
|
|
|
|
my $ctx = context(on_release => sub { 'will run second' }); |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
my $inner = sub { |
1014
|
|
|
|
|
|
|
my $ctx = context(on_release => sub { 'will run first' }); |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
# Neither callback runs on this release |
1017
|
|
|
|
|
|
|
$ctx->release; |
1018
|
|
|
|
|
|
|
} |
1019
|
|
|
|
|
|
|
$inner->(); |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
# Both callbacks run here. |
1022
|
|
|
|
|
|
|
$ctx->release; |
1023
|
|
|
|
|
|
|
} |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=back |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
=head2 release($;$) |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
Usage: |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
=over 4 |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=item release $ctx; |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=item release $ctx, ...; |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
=back |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
This is intended as a shortcut that lets you release your context and return a |
1040
|
|
|
|
|
|
|
value in one statement. This function will get your context, and an optional |
1041
|
|
|
|
|
|
|
return value. It will release your context, then return your value. Scalar |
1042
|
|
|
|
|
|
|
context is always assumed. |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
sub tool { |
1045
|
|
|
|
|
|
|
my $ctx = context(); |
1046
|
|
|
|
|
|
|
... |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
return release $ctx, 1; |
1049
|
|
|
|
|
|
|
} |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
This tool is most useful when you want to return the value you get from calling |
1052
|
|
|
|
|
|
|
a function that needs to see the current context: |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
my $ctx = context(); |
1055
|
|
|
|
|
|
|
my $out = some_tool(...); |
1056
|
|
|
|
|
|
|
$ctx->release; |
1057
|
|
|
|
|
|
|
return $out; |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
We can combine the last 3 lines of the above like so: |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
my $ctx = context(); |
1062
|
|
|
|
|
|
|
release $ctx, some_tool(...); |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
=head2 context_do(&;@) |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
Usage: |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
sub my_tool { |
1069
|
|
|
|
|
|
|
context_do { |
1070
|
|
|
|
|
|
|
my $ctx = shift; |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
my (@args) = @_; |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
$ctx->ok(1, "pass"); |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
... |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
# No need to call $ctx->release, done for you on scope exit. |
1079
|
|
|
|
|
|
|
} @_; |
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
Using this inside your test tool takes care of a lot of boilerplate for you. It |
1083
|
|
|
|
|
|
|
will ensure a context is acquired. It will capture and rethrow any exception. It |
1084
|
|
|
|
|
|
|
will insure the context is released when you are done. It preserves the |
1085
|
|
|
|
|
|
|
subroutine call context (array, scalar, void). |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
This is the safest way to write a test tool. The only two downsides to this are a |
1088
|
|
|
|
|
|
|
slight performance decrease, and some extra indentation in your source. If the |
1089
|
|
|
|
|
|
|
indentation is a problem for you then you can take a peek at the next section. |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=head2 no_context(&;$) |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
Usage: |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
=over 4 |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
=item no_context { ... }; |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
=item no_context { ... } $hid; |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
sub my_tool(&) { |
1102
|
|
|
|
|
|
|
my $code = shift; |
1103
|
|
|
|
|
|
|
my $ctx = context(); |
1104
|
|
|
|
|
|
|
... |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
no_context { |
1107
|
|
|
|
|
|
|
# Things in here will not see our current context, they get a new |
1108
|
|
|
|
|
|
|
# one. |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
$code->(); |
1111
|
|
|
|
|
|
|
}; |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
... |
1114
|
|
|
|
|
|
|
$ctx->release; |
1115
|
|
|
|
|
|
|
}; |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
=back |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
This tool will hide a context for the provided block of code. This means any |
1120
|
|
|
|
|
|
|
tools run inside the block will get a completely new context if they acquire |
1121
|
|
|
|
|
|
|
one. The new context will be inherited by tools nested below the one that |
1122
|
|
|
|
|
|
|
acquired it. |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
This will normally hide the current context for the top hub. If you need to |
1125
|
|
|
|
|
|
|
hide the context for a different hub you can pass in the optional C<$hid> |
1126
|
|
|
|
|
|
|
parameter. |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
=head2 intercept(&) |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
Usage: |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
my $events = intercept { |
1133
|
|
|
|
|
|
|
ok(1, "pass"); |
1134
|
|
|
|
|
|
|
ok(0, "fail"); |
1135
|
|
|
|
|
|
|
... |
1136
|
|
|
|
|
|
|
}; |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
This function takes a codeblock as its only argument, and it has a prototype. |
1139
|
|
|
|
|
|
|
It will execute the codeblock, intercepting any generated events in the |
1140
|
|
|
|
|
|
|
process. It will return an array reference with all the generated event |
1141
|
|
|
|
|
|
|
objects. All events should be subclasses of L<Test2::Event>. |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
As of version 1.302178 the events array that is returned is blssed as an |
1144
|
|
|
|
|
|
|
L<Test2::API::InterceptResult> instance. L<Test2::API::InterceptResult> |
1145
|
|
|
|
|
|
|
Provides a helpful interface for filtering and/or inspecting the events list |
1146
|
|
|
|
|
|
|
overall, or individual events within the list. |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
This is intended to help you test your test code. This is not intended for |
1149
|
|
|
|
|
|
|
people simply writing tests. |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
=head2 run_subtest(...) |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
Usage: |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
run_subtest($NAME, \&CODE, $BUFFERED, @ARGS) |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
# or |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
run_subtest($NAME, \&CODE, \%PARAMS, @ARGS) |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
This will run the provided codeblock with the args in C<@args>. This codeblock |
1162
|
|
|
|
|
|
|
will be run as a subtest. A subtest is an isolated test state that is condensed |
1163
|
|
|
|
|
|
|
into a single L<Test2::Event::Subtest> event, which contains all events |
1164
|
|
|
|
|
|
|
generated inside the subtest. |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=head3 ARGUMENTS: |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
=over 4 |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
=item $NAME |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
The name of the subtest. |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
=item \&CODE |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
The code to run inside the subtest. |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
=item $BUFFERED or \%PARAMS |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
If this is a simple scalar then it will be treated as a boolean for the |
1181
|
|
|
|
|
|
|
'buffered' setting. If this is a hash reference then it will be used as a |
1182
|
|
|
|
|
|
|
parameters hash. The param hash will be used for hub construction (with the |
1183
|
|
|
|
|
|
|
specified keys removed). |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
Keys that are removed and used by run_subtest: |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
=over 4 |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
=item 'buffered' => $bool |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
Toggle buffered status. |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
=item 'inherit_trace' => $bool |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
Normally the subtest hub is pushed and the sub is allowed to generate its own |
1196
|
|
|
|
|
|
|
root context for the hub. When this setting is turned on a root context will be |
1197
|
|
|
|
|
|
|
created for the hub that shares the same trace as the current context. |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
Set this to true if your tool is producing subtests without user-specified |
1200
|
|
|
|
|
|
|
subs. |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
=item 'no_fork' => $bool |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
Defaults to off. Normally forking inside a subtest will actually fork the |
1205
|
|
|
|
|
|
|
subtest, resulting in 2 final subtest events. This parameter will turn off that |
1206
|
|
|
|
|
|
|
behavior, only the original process/thread will return a final subtest event. |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
=back |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=item @ARGS |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
Any extra arguments you want passed into the subtest code. |
1213
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
=back |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
=head3 BUFFERED VS UNBUFFERED (OR STREAMED) |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
Normally all events inside and outside a subtest are sent to the formatter |
1219
|
|
|
|
|
|
|
immediately by the hub. Sometimes it is desirable to hold off sending events |
1220
|
|
|
|
|
|
|
within a subtest until the subtest is complete. This usually depends on the |
1221
|
|
|
|
|
|
|
formatter being used. |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
=over 4 |
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
=item Things not effected by this flag |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
In both cases events are generated and stored in an array. This array is |
1228
|
|
|
|
|
|
|
eventually used to populate the C<subevents> attribute on the |
1229
|
|
|
|
|
|
|
L<Test2::Event::Subtest> event that is generated at the end of the subtest. |
1230
|
|
|
|
|
|
|
This flag has no effect on this part, it always happens. |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
At the end of the subtest, the final L<Test2::Event::Subtest> event is sent to |
1233
|
|
|
|
|
|
|
the formatter. |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
=item Things that are effected by this flag |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
The C<buffered> attribute of the L<Test2::Event::Subtest> event will be set to |
1238
|
|
|
|
|
|
|
the value of this flag. This means any formatter, listener, etc which looks at |
1239
|
|
|
|
|
|
|
the event will know if it was buffered. |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
=item Things that are formatter dependant |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
Events within a buffered subtest may or may not be sent to the formatter as |
1244
|
|
|
|
|
|
|
they happen. If a formatter fails to specify then the default is to B<NOT SEND> |
1245
|
|
|
|
|
|
|
the events as they are generated, instead the formatter can pull them from the |
1246
|
|
|
|
|
|
|
C<subevents> attribute. |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
A formatter can specify by implementing the C<hide_buffered()> method. If this |
1249
|
|
|
|
|
|
|
method returns true then events generated inside a buffered subtest will not be |
1250
|
|
|
|
|
|
|
sent independently of the final subtest event. |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
=back |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
An example of how this is used is the L<Test2::Formatter::TAP> formatter. For |
1255
|
|
|
|
|
|
|
unbuffered subtests the events are rendered as they are generated. At the end |
1256
|
|
|
|
|
|
|
of the subtest, the final subtest event is rendered, but the C<subevents> |
1257
|
|
|
|
|
|
|
attribute is ignored. For buffered subtests the opposite occurs, the events are |
1258
|
|
|
|
|
|
|
NOT rendered as they are generated, instead the C<subevents> attribute is used |
1259
|
|
|
|
|
|
|
to render them all at once. This is useful when running subtests tests in |
1260
|
|
|
|
|
|
|
parallel, since without it the output from subtests would be interleaved |
1261
|
|
|
|
|
|
|
together. |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
=head1 OTHER API EXPORTS |
1264
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
Exports in this section are not commonly needed. These all have the 'test2_' |
1266
|
|
|
|
|
|
|
prefix to help ensure they stand out. You should look at the L</MAIN API |
1267
|
|
|
|
|
|
|
EXPORTS> section before looking here. This section is one where "Great power |
1268
|
|
|
|
|
|
|
comes with great responsibility". It is possible to break things badly if you |
1269
|
|
|
|
|
|
|
are not careful with these. |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
All exports are optional. You need to list which ones you want at import time: |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
use Test2::API qw/test2_init_done .../; |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
=head2 STATUS AND INITIALIZATION STATE |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
These provide access to internal state and object instances. |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
=over 4 |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
=item $bool = test2_init_done() |
1282
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
This will return true if the stack and IPC instances have already been |
1284
|
|
|
|
|
|
|
initialized. It will return false if they have not. Init happens as late as |
1285
|
|
|
|
|
|
|
possible. It happens as soon as a tool requests the IPC instance, the |
1286
|
|
|
|
|
|
|
formatter, or the stack. |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
=item $bool = test2_load_done() |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
This will simply return the boolean value of the loaded flag. If Test2 has |
1291
|
|
|
|
|
|
|
finished loading this will be true, otherwise false. Loading is considered |
1292
|
|
|
|
|
|
|
complete the first time a tool requests a context. |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
=item test2_set_is_end() |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
=item test2_set_is_end($bool) |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
This is used to toggle Test2's belief that the END phase has already started. |
1299
|
|
|
|
|
|
|
With no arguments this will set it to true. With arguments it will set it to |
1300
|
|
|
|
|
|
|
the first argument's value. |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
This is used to prevent the use of C<caller()> in END blocks which can cause |
1303
|
|
|
|
|
|
|
segfaults. This is only necessary in some persistent environments that may have |
1304
|
|
|
|
|
|
|
multiple END phases. |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
=item $bool = test2_get_is_end() |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
Check if Test2 believes it is the END phase. |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
=item $stack = test2_stack() |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
This will return the global L<Test2::API::Stack> instance. If this has not |
1313
|
|
|
|
|
|
|
yet been initialized it will be initialized now. |
1314
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
=item $bool = test2_is_testing_done() |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
This will return true if testing is complete and no other events should be |
1318
|
|
|
|
|
|
|
sent. This is useful in things like warning handlers where you might want to |
1319
|
|
|
|
|
|
|
turn warnings into events, but need them to start acting like normal warnings |
1320
|
|
|
|
|
|
|
when testing is done. |
1321
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
$SIG{__WARN__} = sub { |
1323
|
|
|
|
|
|
|
my ($warning) = @_; |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
if (test2_is_testing_done()) { |
1326
|
|
|
|
|
|
|
warn @_; |
1327
|
|
|
|
|
|
|
} |
1328
|
|
|
|
|
|
|
else { |
1329
|
|
|
|
|
|
|
my $ctx = context(); |
1330
|
|
|
|
|
|
|
... |
1331
|
|
|
|
|
|
|
$ctx->release |
1332
|
|
|
|
|
|
|
} |
1333
|
|
|
|
|
|
|
} |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
=item test2_ipc_disable |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
Disable IPC. |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
=item $bool = test2_ipc_diabled |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
Check if IPC is disabled. |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
=item test2_ipc_wait_enable() |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
=item test2_ipc_wait_disable() |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
=item $bool = test2_ipc_wait_enabled() |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
These can be used to turn IPC waiting on and off, or check the current value of |
1350
|
|
|
|
|
|
|
the flag. |
1351
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
Waiting is turned on by default. Waiting will cause the parent process/thread |
1353
|
|
|
|
|
|
|
to wait until all child processes and threads are finished before exiting. You |
1354
|
|
|
|
|
|
|
will almost never want to turn this off. |
1355
|
|
|
|
|
|
|
|
1356
|
|
|
|
|
|
|
=item $bool = test2_no_wait() |
1357
|
|
|
|
|
|
|
|
1358
|
|
|
|
|
|
|
=item test2_no_wait($bool) |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
B<DISCOURAGED>: This is a confusing interface, it is better to use |
1361
|
|
|
|
|
|
|
C<test2_ipc_wait_enable()>, C<test2_ipc_wait_disable()> and |
1362
|
|
|
|
|
|
|
C<test2_ipc_wait_enabled()>. |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
This can be used to get/set the no_wait status. Waiting is turned on by |
1365
|
|
|
|
|
|
|
default. Waiting will cause the parent process/thread to wait until all child |
1366
|
|
|
|
|
|
|
processes and threads are finished before exiting. You will almost never want |
1367
|
|
|
|
|
|
|
to turn this off. |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
=item $fh = test2_stdout() |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
=item $fh = test2_stderr() |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
These functions return the filehandles that test output should be written to. |
1374
|
|
|
|
|
|
|
They are primarily useful when writing a custom formatter and code that turns |
1375
|
|
|
|
|
|
|
events into actual output (TAP, etc.). They will return a dupe of the original |
1376
|
|
|
|
|
|
|
filehandles that formatted output can be sent to regardless of whatever state |
1377
|
|
|
|
|
|
|
the currently running test may have left STDOUT and STDERR in. |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
=item test2_reset_io() |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
Re-dupe the internal filehandles returned by C<test2_stdout()> and |
1382
|
|
|
|
|
|
|
C<test2_stderr()> from the current STDOUT and STDERR. You shouldn't need to do |
1383
|
|
|
|
|
|
|
this except in very peculiar situations (for example, you're testing a new |
1384
|
|
|
|
|
|
|
formatter and you need control over where the formatter is sending its output.) |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
=back |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
=head2 BEHAVIOR HOOKS |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
These are hooks that allow you to add custom behavior to actions taken by Test2 |
1391
|
|
|
|
|
|
|
and tools built on top of it. |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
=over 4 |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
=item test2_add_callback_exit(sub { ... }) |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
This can be used to add a callback that is called after all testing is done. This |
1398
|
|
|
|
|
|
|
is too late to add additional results, the main use of this callback is to set the |
1399
|
|
|
|
|
|
|
exit code. |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
test2_add_callback_exit( |
1402
|
|
|
|
|
|
|
sub { |
1403
|
|
|
|
|
|
|
my ($context, $exit, \$new_exit) = @_; |
1404
|
|
|
|
|
|
|
... |
1405
|
|
|
|
|
|
|
} |
1406
|
|
|
|
|
|
|
); |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
The C<$context> passed in will be an instance of L<Test2::API::Context>. The |
1409
|
|
|
|
|
|
|
C<$exit> argument will be the original exit code before anything modified it. |
1410
|
|
|
|
|
|
|
C<$$new_exit> is a reference to the new exit code. You may modify this to |
1411
|
|
|
|
|
|
|
change the exit code. Please note that C<$$new_exit> may already be different |
1412
|
|
|
|
|
|
|
from C<$exit> |
1413
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
=item test2_add_callback_post_load(sub { ... }) |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
Add a callback that will be called when Test2 is finished loading. This |
1417
|
|
|
|
|
|
|
means the callback will be run once, the first time a context is obtained. |
1418
|
|
|
|
|
|
|
If Test2 has already finished loading then the callback will be run immediately. |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
=item test2_add_callback_testing_done(sub { ... }) |
1421
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
This adds your coderef as a follow-up to the root hub after Test2 is finished loading. |
1423
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
This is essentially a helper to do the following: |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
test2_add_callback_post_load(sub { |
1427
|
|
|
|
|
|
|
my $stack = test2_stack(); |
1428
|
|
|
|
|
|
|
$stack->top; # Insure we have a hub |
1429
|
|
|
|
|
|
|
my ($hub) = Test2::API::test2_stack->all; |
1430
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
$hub->set_active(1); |
1432
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
$hub->follow_up(sub { ... }); # <-- Your coderef here |
1434
|
|
|
|
|
|
|
}); |
1435
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
=item test2_add_callback_context_acquire(sub { ... }) |
1437
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
Add a callback that will be called every time someone tries to acquire a |
1439
|
|
|
|
|
|
|
context. This will be called on EVERY call to C<context()>. It gets a single |
1440
|
|
|
|
|
|
|
argument, a reference to the hash of parameters being used the construct the |
1441
|
|
|
|
|
|
|
context. This is your chance to change the parameters by directly altering the |
1442
|
|
|
|
|
|
|
hash. |
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
test2_add_callback_context_acquire(sub { |
1445
|
|
|
|
|
|
|
my $params = shift; |
1446
|
|
|
|
|
|
|
$params->{level}++; |
1447
|
|
|
|
|
|
|
}); |
1448
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
This is a very scary API function. Please do not use this unless you need to. |
1450
|
|
|
|
|
|
|
This is here for L<Test::Builder> and backwards compatibility. This has you |
1451
|
|
|
|
|
|
|
directly manipulate the hash instead of returning a new one for performance |
1452
|
|
|
|
|
|
|
reasons. |
1453
|
|
|
|
|
|
|
|
1454
|
|
|
|
|
|
|
=item test2_add_callback_context_init(sub { ... }) |
1455
|
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
Add a callback that will be called every time a new context is created. The |
1457
|
|
|
|
|
|
|
callback will receive the newly created context as its only argument. |
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
=item test2_add_callback_context_release(sub { ... }) |
1460
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
Add a callback that will be called every time a context is released. The |
1462
|
|
|
|
|
|
|
callback will receive the released context as its only argument. |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
=item test2_add_callback_pre_subtest(sub { ... }) |
1465
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
Add a callback that will be called every time a subtest is going to be |
1467
|
|
|
|
|
|
|
run. The callback will receive the subtest name, coderef, and any |
1468
|
|
|
|
|
|
|
arguments. |
1469
|
|
|
|
|
|
|
|
1470
|
|
|
|
|
|
|
=item @list = test2_list_context_acquire_callbacks() |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
Return all the context acquire callback references. |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
=item @list = test2_list_context_init_callbacks() |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
Returns all the context init callback references. |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
=item @list = test2_list_context_release_callbacks() |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
Returns all the context release callback references. |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
=item @list = test2_list_exit_callbacks() |
1483
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
Returns all the exit callback references. |
1485
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
=item @list = test2_list_post_load_callbacks() |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
Returns all the post load callback references. |
1489
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
=item @list = test2_list_pre_subtest_callbacks() |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
Returns all the pre-subtest callback references. |
1493
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
=item test2_add_uuid_via(sub { ... }) |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
=item $sub = test2_add_uuid_via() |
1497
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
This allows you to provide a UUID generator. If provided UUIDs will be attached |
1499
|
|
|
|
|
|
|
to all events, hubs, and contexts. This is useful for storing, tracking, and |
1500
|
|
|
|
|
|
|
linking these objects. |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
The sub you provide should always return a unique identifier. Most things will |
1503
|
|
|
|
|
|
|
expect a proper UUID string, however nothing in Test2::API enforces this. |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
The sub will receive exactly 1 argument, the type of thing being tagged |
1506
|
|
|
|
|
|
|
'context', 'hub', or 'event'. In the future additional things may be tagged, in |
1507
|
|
|
|
|
|
|
which case new strings will be passed in. These are purely informative, you can |
1508
|
|
|
|
|
|
|
(and usually should) ignore them. |
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
=back |
1511
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
=head2 IPC AND CONCURRENCY |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
These let you access, or specify, the IPC system internals. |
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
=over 4 |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
=item $bool = test2_has_ipc() |
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
Check if IPC is enabled. |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
=item $ipc = test2_ipc() |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
This will return the global L<Test2::IPC::Driver> instance. If this has not yet |
1525
|
|
|
|
|
|
|
been initialized it will be initialized now. |
1526
|
|
|
|
|
|
|
|
1527
|
|
|
|
|
|
|
=item test2_ipc_add_driver($DRIVER) |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
Add an IPC driver to the list. This will add the driver to the start of the |
1530
|
|
|
|
|
|
|
list. |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
=item @drivers = test2_ipc_drivers() |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
Get the list of IPC drivers. |
1535
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
=item $bool = test2_ipc_polling() |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
Check if polling is enabled. |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
=item test2_ipc_enable_polling() |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
Turn on polling. This will cull events from other processes and threads every |
1543
|
|
|
|
|
|
|
time a context is created. |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
=item test2_ipc_disable_polling() |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
Turn off IPC polling. |
1548
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
=item test2_ipc_enable_shm() |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
Legacy, this is currently a no-op that returns 0; |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
=item test2_ipc_set_pending($uniq_val) |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
Tell other processes and events that an event is pending. C<$uniq_val> should |
1556
|
|
|
|
|
|
|
be a unique value no other thread/process will generate. |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
B<Note:> After calling this C<test2_ipc_get_pending()> will return 1. This is |
1559
|
|
|
|
|
|
|
intentional, and not avoidable. |
1560
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
=item $pending = test2_ipc_get_pending() |
1562
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
This returns -1 if there is no way to check (assume yes) |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
This returns 0 if there are (most likely) no pending events. |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
This returns 1 if there are (likely) pending events. Upon return it will reset, |
1568
|
|
|
|
|
|
|
nothing else will be able to see that there were pending events. |
1569
|
|
|
|
|
|
|
|
1570
|
|
|
|
|
|
|
=item $timeout = test2_ipc_get_timeout() |
1571
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
=item test2_ipc_set_timeout($timeout) |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
Get/Set the timeout value for the IPC system. This timeout is how long the IPC |
1575
|
|
|
|
|
|
|
system will wait for child processes and threads to finish before aborting. |
1576
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
The default value is C<30> seconds. |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
=back |
1580
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
=head2 MANAGING FORMATTERS |
1582
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
These let you access, or specify, the formatters that can/should be used. |
1584
|
|
|
|
|
|
|
|
1585
|
|
|
|
|
|
|
=over 4 |
1586
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
=item $formatter = test2_formatter |
1588
|
|
|
|
|
|
|
|
1589
|
|
|
|
|
|
|
This will return the global formatter class. This is not an instance. By |
1590
|
|
|
|
|
|
|
default the formatter is set to L<Test2::Formatter::TAP>. |
1591
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
You can override this default using the C<T2_FORMATTER> environment variable. |
1593
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
Normally 'Test2::Formatter::' is prefixed to the value in the |
1595
|
|
|
|
|
|
|
environment variable: |
1596
|
|
|
|
|
|
|
|
1597
|
|
|
|
|
|
|
$ T2_FORMATTER='TAP' perl test.t # Use the Test2::Formatter::TAP formatter |
1598
|
|
|
|
|
|
|
$ T2_FORMATTER='Foo' perl test.t # Use the Test2::Formatter::Foo formatter |
1599
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
If you want to specify a full module name you use the '+' prefix: |
1601
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
$ T2_FORMATTER='+Foo::Bar' perl test.t # Use the Foo::Bar formatter |
1603
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
=item test2_formatter_set($class_or_instance) |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
Set the global formatter class. This can only be set once. B<Note:> This will |
1607
|
|
|
|
|
|
|
override anything specified in the 'T2_FORMATTER' environment variable. |
1608
|
|
|
|
|
|
|
|
1609
|
|
|
|
|
|
|
=item @formatters = test2_formatters() |
1610
|
|
|
|
|
|
|
|
1611
|
|
|
|
|
|
|
Get a list of all loaded formatters. |
1612
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
=item test2_formatter_add($class_or_instance) |
1614
|
|
|
|
|
|
|
|
1615
|
|
|
|
|
|
|
Add a formatter to the list. Last formatter added is used at initialization. If |
1616
|
|
|
|
|
|
|
this is called after initialization a warning will be issued. |
1617
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
=back |
1619
|
|
|
|
|
|
|
|
1620
|
|
|
|
|
|
|
=head1 OTHER EXAMPLES |
1621
|
|
|
|
|
|
|
|
1622
|
|
|
|
|
|
|
See the C</Examples/> directory included in this distribution. |
1623
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
=head1 SEE ALSO |
1625
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
L<Test2::API::Context> - Detailed documentation of the context object. |
1627
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
L<Test2::IPC> - The IPC system used for threading/fork support. |
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
L<Test2::Formatter> - Formatters such as TAP live here. |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
L<Test2::Event> - Events live in this namespace. |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
L<Test2::Hub> - All events eventually funnel through a hub. Custom hubs are how |
1635
|
|
|
|
|
|
|
C<intercept()> and C<run_subtest()> are implemented. |
1636
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
=head1 MAGIC |
1638
|
|
|
|
|
|
|
|
1639
|
|
|
|
|
|
|
This package has an END block. This END block is responsible for setting the |
1640
|
|
|
|
|
|
|
exit code based on the test results. This end block also calls the callbacks that |
1641
|
|
|
|
|
|
|
can be added to this package. |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
=head1 SOURCE |
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
The source code repository for Test2 can be found at |
1646
|
|
|
|
|
|
|
F<http://github.com/Test-More/test-more/>. |
1647
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
=head1 MAINTAINERS |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
=over 4 |
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
=item Chad Granum E<lt>exodist@cpan.orgE<gt> |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
=back |
1655
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
=head1 AUTHORS |
1657
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
=over 4 |
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
=item Chad Granum E<lt>exodist@cpan.orgE<gt> |
1661
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
=back |
1663
|
|
|
|
|
|
|
|
1664
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1665
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>. |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
1669
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
1670
|
|
|
|
|
|
|
|
1671
|
|
|
|
|
|
|
See F<http://dev.perl.org/licenses/> |
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
=cut |