line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#line 1 |
2
|
|
|
|
|
|
|
package Test::Most; |
3
|
1
|
|
|
1
|
|
777
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
4
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
30
|
|
5
|
|
|
|
|
|
|
use strict; |
6
|
1
|
|
|
1
|
|
921
|
|
|
1
|
|
|
|
|
32889
|
|
|
1
|
|
|
|
|
647
|
|
7
|
|
|
|
|
|
|
use Test::Most::Exception 'throw_failure'; |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
1388
|
# XXX don't use 'base' as it can override signal handlers |
|
1
|
|
|
|
|
44753
|
|
|
1
|
|
|
|
|
9
|
|
10
|
|
|
|
|
|
|
use Test::Builder::Module; |
11
|
|
|
|
|
|
|
our ( @ISA, @EXPORT, $DATA_DUMPER_NAMES_INSTALLED ); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
BEGIN { |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# There's some strange fiddling around with import(), so this allows us to |
16
|
1
|
|
|
1
|
|
752
|
# be nicely backwards compatible to earlier versions of Test::More. |
17
|
1
|
|
|
|
|
6
|
require Test::More; |
|
28
|
|
|
|
|
48
|
|
18
|
1
|
|
|
|
|
13
|
@Test::More::EXPORT = grep { $_ ne 'explain' } @Test::More::EXPORT; |
19
|
|
|
|
|
|
|
Test::More->import; |
20
|
|
|
|
|
|
|
} |
21
|
1
|
|
|
1
|
|
304
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
36
|
|
22
|
|
|
|
|
|
|
use Test::Builder; |
23
|
|
|
|
|
|
|
my $OK_FUNC; |
24
|
1
|
|
|
1
|
|
120
|
BEGIN { |
25
|
|
|
|
|
|
|
$OK_FUNC = \&Test::Builder::ok; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
#line 35 |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
our $VERSION = '0.23'; |
31
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
#line 395 |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
BEGIN { |
36
|
|
|
|
|
|
|
@ISA = qw(Test::Builder::Module); |
37
|
|
|
|
|
|
|
@EXPORT = ( |
38
|
|
|
|
|
|
|
@Test::More::EXPORT, |
39
|
|
|
|
|
|
|
qw< |
40
|
|
|
|
|
|
|
all_done |
41
|
|
|
|
|
|
|
bail_on_fail |
42
|
|
|
|
|
|
|
die_on_fail |
43
|
|
|
|
|
|
|
explain |
44
|
|
|
|
|
|
|
always_explain |
45
|
|
|
|
|
|
|
last_test_failed |
46
|
|
|
|
|
|
|
restore_fail |
47
|
|
|
|
|
|
|
set_failure_handler |
48
|
|
|
|
|
|
|
show |
49
|
|
|
|
|
|
|
always_show |
50
|
|
|
|
|
|
|
> |
51
|
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub import { |
55
|
|
|
|
|
|
|
my $bail_set = 0; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
my %modules_to_load = map { $_ => 1 } qw/ |
58
|
|
|
|
|
|
|
Test::Differences |
59
|
|
|
|
|
|
|
Test::Exception |
60
|
|
|
|
|
|
|
Test::Deep |
61
|
|
|
|
|
|
|
Test::Warn |
62
|
|
|
|
|
|
|
/; |
63
|
|
|
|
|
|
|
warnings->import; |
64
|
|
|
|
|
|
|
strict->import; |
65
|
|
|
|
|
|
|
eval "use Data::Dumper::Names 0.03"; |
66
|
|
|
|
|
|
|
$DATA_DUMPER_NAMES_INSTALLED = !$@; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
if ( $ENV{BAIL_ON_FAIL} ) { |
69
|
|
|
|
|
|
|
$bail_set = 1; |
70
|
|
|
|
|
|
|
bail_on_fail(); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
if ( !$bail_set and $ENV{DIE_ON_FAIL} ) { |
73
|
|
|
|
|
|
|
die_on_fail(); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
for my $i ( 0 .. $#_ ) { |
76
|
|
|
|
|
|
|
if ( 'bail' eq $_[$i] ) { |
77
|
|
|
|
|
|
|
splice @_, $i, 1; |
78
|
|
|
|
|
|
|
bail_on_fail(); |
79
|
|
|
|
|
|
|
$bail_set = 1; |
80
|
|
|
|
|
|
|
last; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
my @exclude_symbols; |
85
|
|
|
|
|
|
|
my $i = 0; |
86
|
|
|
|
|
|
|
while ($i < @_) { |
87
|
|
|
|
|
|
|
if ( !$bail_set and ( 'die' eq $_[$i] ) ) { |
88
|
|
|
|
|
|
|
splice @_, $i, 1; |
89
|
|
|
|
|
|
|
die_on_fail(); |
90
|
|
|
|
|
|
|
$i = 0; |
91
|
|
|
|
|
|
|
next; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
if ( $_[$i] =~ /^-(.*)/ ) { |
94
|
|
|
|
|
|
|
my $module = $1; |
95
|
|
|
|
|
|
|
splice @_, $i, 1; |
96
|
|
|
|
|
|
|
unless (exists $modules_to_load{$module}) { |
97
|
|
|
|
|
|
|
require Carp; |
98
|
|
|
|
|
|
|
Carp::croak("Cannot remove non-existent Test::Module ($module)"); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
delete $modules_to_load{$module}; |
101
|
|
|
|
|
|
|
$i = 0; |
102
|
|
|
|
|
|
|
next; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
if ( $_[$i] =~ /^!(.*)/ ) { |
105
|
|
|
|
|
|
|
splice @_, $i, 1; |
106
|
|
|
|
|
|
|
push @exclude_symbols => $1; |
107
|
|
|
|
|
|
|
$i = 0; |
108
|
|
|
|
|
|
|
next; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
if ( 'defer_plan' eq $_[$i] ) { |
111
|
|
|
|
|
|
|
splice @_, $i, 1; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
my $builder = Test::Builder->new; |
114
|
|
|
|
|
|
|
$builder->{Have_Plan} = 1 |
115
|
|
|
|
|
|
|
; # don't like setting this directly, but Test::Builder::has_plan doe |
116
|
|
|
|
|
|
|
$builder->{TEST_MOST_deferred_plan} = 1; |
117
|
|
|
|
|
|
|
$builder->{TEST_MOST_all_done} = 0; |
118
|
|
|
|
|
|
|
$i = 0; |
119
|
|
|
|
|
|
|
next; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
$i++; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
foreach my $module (keys %modules_to_load) { |
124
|
|
|
|
|
|
|
# some Test modules we use are naughty and don't use Exporter. |
125
|
|
|
|
|
|
|
# See RT#61145. |
126
|
|
|
|
|
|
|
if ($module->isa('Exporter')) { |
127
|
|
|
|
|
|
|
my $exclude_symbols = 'qw(' . join(' ', map { '!' . $_ } @exclude_symbols) . ')'; |
128
|
|
|
|
|
|
|
eval "require $module; import $module $exclude_symbols;"; |
129
|
|
|
|
|
|
|
} else { |
130
|
|
|
|
|
|
|
eval "use $module"; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
if ( my $error = $@) { |
134
|
|
|
|
|
|
|
require Carp; |
135
|
|
|
|
|
|
|
Carp::croak($error); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
no strict 'refs'; |
138
|
|
|
|
|
|
|
my %count; |
139
|
|
|
|
|
|
|
$count{$_}++ foreach @{"${module}::EXPORT"}, @exclude_symbols; |
140
|
|
|
|
|
|
|
# Note: export_to_level would be better here. |
141
|
|
|
|
|
|
|
push @EXPORT => grep { $count{$_} == 1 } @{"${module}::EXPORT"}; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# 'magic' goto to avoid updating the callstack |
145
|
|
|
|
|
|
|
goto &Test::Builder::Module::import; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub explain { |
149
|
|
|
|
|
|
|
_explain(\&Test::More::note, @_); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub always_explain { |
153
|
|
|
|
|
|
|
_explain(\&Test::More::diag, @_); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub _explain { |
157
|
|
|
|
|
|
|
my $diag = shift; |
158
|
|
|
|
|
|
|
no warnings 'once'; |
159
|
|
|
|
|
|
|
$diag->( |
160
|
|
|
|
|
|
|
map { |
161
|
|
|
|
|
|
|
ref $_ |
162
|
|
|
|
|
|
|
? do { |
163
|
|
|
|
|
|
|
require Data::Dumper; |
164
|
|
|
|
|
|
|
local $Data::Dumper::Indent = 1; |
165
|
|
|
|
|
|
|
local $Data::Dumper::Sortkeys = 1; |
166
|
|
|
|
|
|
|
local $Data::Dumper::Terse = 1; |
167
|
|
|
|
|
|
|
Data::Dumper::Dumper($_); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
: $_ |
170
|
|
|
|
|
|
|
} @_ |
171
|
|
|
|
|
|
|
); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub show { |
175
|
|
|
|
|
|
|
_show(\&Test::More::note, @_); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub always_show { |
179
|
|
|
|
|
|
|
_show(\&Test::More::diag, @_); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub _show { |
183
|
|
|
|
|
|
|
unless ( $DATA_DUMPER_NAMES_INSTALLED ) { |
184
|
|
|
|
|
|
|
warn "Data::Dumper::Names 0.03 not found. Use explain() instead of show()"; |
185
|
|
|
|
|
|
|
goto &_explain; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
my $diag = shift; |
188
|
|
|
|
|
|
|
no warnings 'once'; |
189
|
|
|
|
|
|
|
local $Data::Dumper::Indent = 1; |
190
|
|
|
|
|
|
|
local $Data::Dumper::Sortkeys = 1; |
191
|
|
|
|
|
|
|
local $Data::Dumper::Names::UpLevel = $Data::Dumper::Names::UpLevel + 2; |
192
|
|
|
|
|
|
|
$diag->(Data::Dumper::Names::Dumper(@_)); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub die_on_fail { |
196
|
|
|
|
|
|
|
set_failure_handler( sub { throw_failure } ); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub bail_on_fail { |
200
|
|
|
|
|
|
|
set_failure_handler( |
201
|
|
|
|
|
|
|
sub { Test::More::BAIL_OUT("Test failed. BAIL OUT!.\n") } ); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub restore_fail { |
205
|
|
|
|
|
|
|
no warnings 'redefine'; |
206
|
|
|
|
|
|
|
*Test::Builder::ok = $OK_FUNC; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub all_done { |
210
|
|
|
|
|
|
|
my $builder = Test::Builder->new; |
211
|
|
|
|
|
|
|
if ($builder->{TEST_MOST_deferred_plan}) { |
212
|
|
|
|
|
|
|
$builder->{TEST_MOST_all_done} = 1; |
213
|
|
|
|
|
|
|
$builder->expected_tests(@_ ? $_[0] : $builder->current_test); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub set_failure_handler { |
219
|
|
|
|
|
|
|
my $action = shift; |
220
|
|
|
|
|
|
|
no warnings 'redefine'; |
221
|
|
|
|
|
|
|
Test::Builder->new->{TEST_MOST_failure_action} = $action; # for DESTROY |
222
|
|
|
|
|
|
|
*Test::Builder::ok = sub { |
223
|
|
|
|
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1; |
224
|
|
|
|
|
|
|
my $builder = $_[0]; |
225
|
|
|
|
|
|
|
if ( $builder->{TEST_MOST_test_failed} ) { |
226
|
|
|
|
|
|
|
$builder->{TEST_MOST_test_failed} = 0; |
227
|
|
|
|
|
|
|
$action->($builder); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
$builder->{TEST_MOST_test_failed} = 0; |
230
|
|
|
|
|
|
|
my $result = $OK_FUNC->(@_); |
231
|
|
|
|
|
|
|
$builder->{TEST_MOST_test_failed} = !( $builder->summary )[-1]; |
232
|
|
|
|
|
|
|
return $result; |
233
|
|
|
|
|
|
|
}; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
{ |
237
|
|
|
|
|
|
|
no warnings 'redefine'; |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# we need this because if the failure is on the final test, we won't have |
240
|
|
|
|
|
|
|
# a subsequent test triggering the behavior. |
241
|
|
|
|
|
|
|
sub Test::Builder::DESTROY { |
242
|
|
|
|
|
|
|
my $builder = $_[0]; |
243
|
|
|
|
|
|
|
if ( $builder->{TEST_MOST_test_failed} ) { |
244
|
|
|
|
|
|
|
$builder->{TEST_MOST_failure_action}->(); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub _deferred_plan_handler { |
250
|
|
|
|
|
|
|
my $builder = Test::Builder->new; |
251
|
|
|
|
|
|
|
if ($builder->{TEST_MOST_deferred_plan} and !$builder->{TEST_MOST_all_done}) |
252
|
|
|
|
|
|
|
{ |
253
|
|
|
|
|
|
|
$builder->expected_tests($builder->current_test + 1); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# This should work because the END block defined by Test::Builder should be |
258
|
|
|
|
|
|
|
# guaranteed to be run before t one, since we use'd Test::Builder way up top. |
259
|
|
|
|
|
|
|
# The other two alternatives would be either to replace Test::Builder::_ending |
260
|
|
|
|
|
|
|
# similar to how we did Test::Builder::ok, or to call Test::Builder::no_ending |
261
|
|
|
|
|
|
|
# and basically rewrite _ending in our own image. Neither is very palatable, |
262
|
|
|
|
|
|
|
# considering _ending's initial underscore. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
END { |
265
|
|
|
|
|
|
|
_deferred_plan_handler(); |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
1; |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
#line 739 |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
1; |