line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Aggregate; |
2
|
|
|
|
|
|
|
|
3
|
13
|
|
|
13
|
|
136510
|
use warnings; |
|
13
|
|
|
|
|
21
|
|
|
13
|
|
|
|
|
439
|
|
4
|
13
|
|
|
13
|
|
759
|
use strict; |
|
13
|
|
|
|
|
1006
|
|
|
13
|
|
|
|
|
615
|
|
5
|
11
|
|
|
11
|
|
47
|
use Carp 'croak'; |
|
11
|
|
|
|
|
21
|
|
|
11
|
|
|
|
|
700
|
|
6
|
|
|
|
|
|
|
|
7
|
11
|
|
|
11
|
|
3533
|
use Test::More; |
|
11
|
|
|
|
|
70390
|
|
|
11
|
|
|
|
|
100
|
|
8
|
11
|
|
|
11
|
|
8128
|
use Test::Aggregate::Base; |
|
11
|
|
|
|
|
26
|
|
|
11
|
|
|
|
|
111
|
|
9
|
11
|
|
|
11
|
|
1876
|
use vars qw(@ISA @EXPORT @EXPORT_OK); |
|
11
|
|
|
|
|
990
|
|
|
11
|
|
|
|
|
8927
|
|
10
|
|
|
|
|
|
|
@ISA = qw(Test::Aggregate::Base); |
11
|
|
|
|
|
|
|
@EXPORT = (@Test::More::EXPORT, 'run_this_test_program'); |
12
|
|
|
|
|
|
|
# controls whether or not we show individual test program pass/fail |
13
|
|
|
|
|
|
|
my %VERBOSE = ( |
14
|
|
|
|
|
|
|
none => 0, |
15
|
|
|
|
|
|
|
failures => 1, |
16
|
|
|
|
|
|
|
all => 2, |
17
|
|
|
|
|
|
|
); |
18
|
|
|
|
|
|
|
my $BUILDER = Test::Builder->new; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=encoding utf-8 |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Test::Aggregate - Aggregate C<*.t> tests to make them run faster. |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 VERSION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Version 0.373 |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=cut |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $VERSION = '0.373'; |
33
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 SYNOPSIS |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
use Test::Aggregate; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $tests = Test::Aggregate->new( { |
40
|
|
|
|
|
|
|
dirs => $aggregate_test_dir, |
41
|
|
|
|
|
|
|
} ); |
42
|
|
|
|
|
|
|
$tests->run; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
ok $some_data, 'Test::Aggregate also re-exports Test::More functions'; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 DESCRIPTION |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
B<WARNING>: this is ALPHA code. The interface is not guaranteed to be |
49
|
|
|
|
|
|
|
stable. Further, check out L<Test::Aggregate::Nested> (included with this |
50
|
|
|
|
|
|
|
distribution). It's a more robust implementation which does not have the same |
51
|
|
|
|
|
|
|
limitations as C<Test::Aggregate>. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
A common problem with many test suites is that they can take a long time to |
54
|
|
|
|
|
|
|
run. The longer they run, the less likely you are to run the tests. This |
55
|
|
|
|
|
|
|
module borrows a trick from C<Apache::Registry> to load up your tests at once, |
56
|
|
|
|
|
|
|
create a separate package for each test and wraps each package in a method |
57
|
|
|
|
|
|
|
named C<run_the_tests>. This allows us to load perl only once and related |
58
|
|
|
|
|
|
|
modules only once. If you have modules which are expensive to load, this can |
59
|
|
|
|
|
|
|
dramatically speed up a test suite. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 DEPRECATION |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
For a whole variety of reasons, tests run in BEGIN/CHECK/INIT/INIT blocks are |
64
|
|
|
|
|
|
|
now deprecated. They cause all sorts of test sequence headaches. Plus, they |
65
|
|
|
|
|
|
|
break the up-coming nested TAP work. You will have a problem if you use this |
66
|
|
|
|
|
|
|
common idiom: |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
BEGIN { |
69
|
|
|
|
|
|
|
use_ok 'My::Module' or die; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
Instead, just C<use> the module and put the C<use_ok> tests in a t/load.t file |
73
|
|
|
|
|
|
|
or something similar and B<don't> aggregate it. See the following for more |
74
|
|
|
|
|
|
|
information: L<http://use.perl.org/~Ovid/journal/38974>. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head1 USAGE |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
Create a separate directory for your tests. This should not be a subdirectory |
79
|
|
|
|
|
|
|
of your regular test directory. Write a small driver program and put it in |
80
|
|
|
|
|
|
|
your regular test directory (C<t/> is the standard): |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
use Test::Aggregate; |
83
|
|
|
|
|
|
|
my $other_test_dir = 'aggregate_tests'; |
84
|
|
|
|
|
|
|
my $tests = Test::Aggregate->new( { |
85
|
|
|
|
|
|
|
dirs => $other_test_dir |
86
|
|
|
|
|
|
|
}); |
87
|
|
|
|
|
|
|
$tests->run; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
ok $some_data, 'Test::Aggregate also re-exports Test::More functions'; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Take your simplest tests and move them, one by one, into the new test |
92
|
|
|
|
|
|
|
directory and keep running the C<Test::Aggregate> program. You'll find some |
93
|
|
|
|
|
|
|
tests will not run in a shared environment like this. You can either fix the |
94
|
|
|
|
|
|
|
tests or simply leave them in your regular test directory. See how this |
95
|
|
|
|
|
|
|
distribution's tests are organized for an example. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Note that C<Test::Aggregate> also exports all exported functions from |
98
|
|
|
|
|
|
|
C<Test::More>, allowing you to run other tests after the aggregated tests have |
99
|
|
|
|
|
|
|
run. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
use Test::Aggregate; |
102
|
|
|
|
|
|
|
my $other_test_dir = 'aggregate_tests'; |
103
|
|
|
|
|
|
|
my $tests = Test::Aggregate->new( { |
104
|
|
|
|
|
|
|
dirs => $other_test_dir |
105
|
|
|
|
|
|
|
}); |
106
|
|
|
|
|
|
|
$tests->run; |
107
|
|
|
|
|
|
|
ok !(-f 't/data/tmp.txt'), '... and our temp file should be deleted'; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Some tests cannot run in an aggregate environment. These may include |
110
|
|
|
|
|
|
|
test for this with the C<< $ENV{TEST_AGGREGATE} >> variable: |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
package Some::Package; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
BEGIN { |
115
|
|
|
|
|
|
|
die __PACKAGE__ ." cannot run in aggregated tests" |
116
|
|
|
|
|
|
|
if $ENV{TEST_AGGREGATE}; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head1 METHODS |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=head2 C<new> |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
my $tests = Test::Aggregate->new( |
124
|
|
|
|
|
|
|
{ |
125
|
|
|
|
|
|
|
dirs => 'aggtests', |
126
|
|
|
|
|
|
|
verbose => 1, # optional, but recommended |
127
|
|
|
|
|
|
|
dump => 'dump.t', # optional |
128
|
|
|
|
|
|
|
shuffle => 1, # optional |
129
|
|
|
|
|
|
|
matching => qr/customer/, # optional |
130
|
|
|
|
|
|
|
set_filenames => 0, # optional and not recommended |
131
|
|
|
|
|
|
|
tidy => 1, # optional and experimental |
132
|
|
|
|
|
|
|
test_nowarnings => 0, # optional and experimental |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Creates a new C<Test::Aggregate> instance. Accepts a hashref with the |
137
|
|
|
|
|
|
|
following keys: |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=over 4 |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=item * C<dirs> (either this or C<tests> is mandatory) |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
The directories to look in for the aggregated tests. This may be a scalar |
144
|
|
|
|
|
|
|
value of a single directory or an array refernce of multiple directories. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=item * C<tests> (either this or C<dirs> is mandatory) |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Instead of providing directories for the aggregated tests, you may supply an |
149
|
|
|
|
|
|
|
array reference with a list of tests to aggregate. If both are supplied, |
150
|
|
|
|
|
|
|
these tests will be appended to the list of tests found in C<dirs>. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
The C<matching> parameter does not apply to test files identified with this |
153
|
|
|
|
|
|
|
key. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item * C<verbose> (optional, but strongly recommended) |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
If set with a true value, each test programs success or failure will be |
158
|
|
|
|
|
|
|
indicated with a diagnostic output. The output below means that |
159
|
|
|
|
|
|
|
C<aggtests/slow_load.t> was an aggregated test which failed. This means it's |
160
|
|
|
|
|
|
|
much easier to determine which aggregated tests are causing problems. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
t/aggregate.........2/? |
163
|
|
|
|
|
|
|
# ok - aggtests/boilerplate.t |
164
|
|
|
|
|
|
|
# ok - aggtests/00-load.t |
165
|
|
|
|
|
|
|
# not ok - aggtests/subs.t |
166
|
|
|
|
|
|
|
# ok - aggtests/slow_load.t |
167
|
|
|
|
|
|
|
t/aggregate.........ok |
168
|
|
|
|
|
|
|
t/pod-coverage......ok |
169
|
|
|
|
|
|
|
t/pod...............ok |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
Note that three possible values are allowed for C<verbose>: |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=over 4 |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=item * C<0> (default) |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
No individual test program success or failure will be displayed. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=item * C<1> |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Only failing test programs will have their failure status shown. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=item * C<2> |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
All test programs will have their success/failure shown. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=back |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=item * C<dump> (optional) |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
You may list the name of a file to dump the aggregated tests to. This is |
192
|
|
|
|
|
|
|
useful if you have test failures and need to debug why the tests failed. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=item * C<shuffle> (optional) |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Ordinarily, the tests are sorted by name and run in that order. This allows |
197
|
|
|
|
|
|
|
you to run them in any order. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=item * C<matching> (optional) |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
If supplied with a regular expression (requires the C<qr> operator), will only |
202
|
|
|
|
|
|
|
run tests whose filename matches the regular expression. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=item * C<set_filenames> (optional) |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
If supplied with a true value, this will cause the following to be added for |
207
|
|
|
|
|
|
|
each test: |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
local $0 = $test_filename; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
This is the default behavior. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=item * C<findbin> (optional) |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
If supplied with a true value, this will cause FindBin::again() to be called |
216
|
|
|
|
|
|
|
before each test file. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
This is turned off by default. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Note that older versions of FindBin (pre 1.47) sometimes get confused about |
221
|
|
|
|
|
|
|
where the bin directory is when I set C<$0>. I don't know why, but this is a |
222
|
|
|
|
|
|
|
rarely used option and only happens pre 5.8 perl, so I'm not too worried about |
223
|
|
|
|
|
|
|
it. Just keep it in mind. |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=item * C<dry> (optional) |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
Just print the tests which will be run and the order they will be run in |
228
|
|
|
|
|
|
|
(obviously the order will be random if C<shuffle> is true). |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=item * C<tidy> |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
If supplied a true value, attempts to run C<Perl::Tidy> on the source code. |
234
|
|
|
|
|
|
|
This is a no-op if C<Perl::Tidy> cannot be loaded. This option is |
235
|
|
|
|
|
|
|
C<experimental>. Plus, if your tests are terribly convoluted, this could be |
236
|
|
|
|
|
|
|
slow and possibly buggy. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
If the value of this argument is the name of a file, assumes that this file is |
239
|
|
|
|
|
|
|
a C<.perltidyrc> file. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=item * C<test_nowarnings> |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Disables C<Test::NoWarnings> (fails if the module cannot be loaded). |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
This is experimental and somewhat problematic. Let me know if there are any |
246
|
|
|
|
|
|
|
problems. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=back |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=cut |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
sub new { |
253
|
8
|
|
|
8
|
1
|
446
|
my $class = shift; |
254
|
8
|
|
|
|
|
127
|
my $self = $class->SUPER::new(@_); |
255
|
8
|
50
|
|
|
|
43
|
if ($self->{no_generate_plan}) { |
256
|
0
|
|
|
|
|
0
|
croak "no_generate_plan is not supported in Test::Aggregate"; |
257
|
|
|
|
|
|
|
} |
258
|
8
|
|
|
|
|
40
|
return $self; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head2 C<run> |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
$tests->run; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
Attempts to aggregate and run all tests listed in the directories specified in |
266
|
|
|
|
|
|
|
the constructor. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=cut |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
0
|
|
|
sub _do_dry_run { |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub run { |
274
|
8
|
|
|
8
|
1
|
50
|
my $self = shift; |
275
|
|
|
|
|
|
|
|
276
|
8
|
|
|
|
|
51
|
local $Test::Aggregate::Base::_pid = $$; |
277
|
|
|
|
|
|
|
|
278
|
8
|
|
|
|
|
68
|
my $verbose = $self->_verbose; |
279
|
|
|
|
|
|
|
|
280
|
8
|
|
|
|
|
76
|
my @tests = $self->_get_tests; |
281
|
8
|
50
|
|
|
|
72
|
if ( $self->_dry ) { |
282
|
0
|
|
|
|
|
0
|
my $current = 1; |
283
|
0
|
|
|
|
|
0
|
my $total = @tests; |
284
|
0
|
|
|
|
|
0
|
foreach my $test (@tests) { |
285
|
0
|
|
|
|
|
0
|
print "$test (File $current out of $total)\n"; |
286
|
0
|
|
|
|
|
0
|
$current++; |
287
|
|
|
|
|
|
|
} |
288
|
0
|
|
|
|
|
0
|
return; |
289
|
|
|
|
|
|
|
} |
290
|
8
|
|
|
|
|
47
|
my $code = $self->_build_aggregate_code(@tests); |
291
|
|
|
|
|
|
|
|
292
|
7
|
|
|
|
|
29
|
my $dump = $self->_dump; |
293
|
7
|
50
|
|
|
|
25
|
if ( $dump ne '' ) { |
294
|
0
|
|
|
|
|
0
|
local *FH; |
295
|
0
|
0
|
|
|
|
0
|
open FH, "> $dump" or die "Could not open ($dump) for writing: $!"; |
296
|
0
|
|
|
|
|
0
|
print FH $code; |
297
|
0
|
|
|
|
|
0
|
close FH; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
# XXX Theoretically the 'eval $code' could run the tests directly and |
301
|
|
|
|
|
|
|
# remove a lot of annoying duplication, but unfortunately, we can't |
302
|
|
|
|
|
|
|
# properly capture the startup/shutdown/setup/teardown behavior there |
303
|
|
|
|
|
|
|
# without mandating that Data::Dump::Streamer be installed. As a result, |
304
|
|
|
|
|
|
|
# this eval'ed code has a check to not actually run the tests if we are |
305
|
|
|
|
|
|
|
# not in the dump file. |
306
|
7
|
|
|
7
|
|
584
|
eval $code; |
|
7
|
|
|
7
|
|
60
|
|
|
7
|
|
|
7
|
|
7
|
|
|
7
|
|
|
7
|
|
99
|
|
|
7
|
|
|
|
|
5867
|
|
|
7
|
|
|
|
|
17
|
|
|
7
|
|
|
|
|
252
|
|
|
7
|
|
|
|
|
27
|
|
|
7
|
|
|
|
|
3830
|
|
|
6
|
|
|
|
|
4904
|
|
|
6
|
|
|
|
|
1382
|
|
307
|
|
|
|
|
|
|
|
308
|
7
|
50
|
|
|
|
198
|
if ( my $error = $@ ) { |
309
|
0
|
|
|
|
|
0
|
croak("Could not run tests: $@"); |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
7
|
100
|
|
|
|
60
|
$self->_startup->() if $self->_startup; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# some tests may have been run in BEGIN blocks. This is deprecated and |
315
|
|
|
|
|
|
|
# now warns |
316
|
7
|
|
|
|
|
27
|
my $tab = 'Test::Aggregate::Builder'; |
317
|
7
|
|
50
|
|
|
22
|
$BUILDER->{$tab}{last_test} = @{ $BUILDER->{Test_Results} } || 0; |
318
|
7
|
|
|
|
|
38
|
$BUILDER->{$tab}{aggregate_program} = $self->{aggregate_program}; |
319
|
|
|
|
|
|
|
|
320
|
7
|
|
|
|
|
24
|
my $current_test = 0; |
321
|
7
|
|
|
|
|
74
|
my @packages = $self->_packages; |
322
|
7
|
|
|
|
|
22
|
my $total_tests = @packages; |
323
|
7
|
|
|
|
|
28
|
foreach my $data (@packages) { |
324
|
23
|
|
|
|
|
237
|
$current_test++; |
325
|
23
|
|
|
|
|
80
|
my ( $test, $package ) = @$data; |
326
|
23
|
100
|
|
|
|
97
|
$self->_setup->($test) if $self->_setup; |
327
|
23
|
|
|
|
|
130
|
run_this_test_program( $package => $test, $current_test, $total_tests, $verbose ); |
328
|
22
|
50
|
|
|
|
75
|
if ( my $error = $@ ) { |
329
|
0
|
|
|
|
|
0
|
Test::More::ok( 0, "Error running ($test): $error" ); |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# XXX this should be fine since these keys are not actually used |
333
|
|
|
|
|
|
|
# internally. |
334
|
22
|
|
|
|
|
55
|
$BUILDER->{XXX_test_failed} = 0; |
335
|
22
|
|
|
|
|
50
|
$BUILDER->{TEST_MOST_test_failed} = 0; |
336
|
22
|
100
|
|
|
|
130
|
$self->_teardown->($test) if $self->_teardown; |
337
|
|
|
|
|
|
|
} |
338
|
6
|
100
|
|
|
|
38
|
$self->_shutdown->() if $self->_shutdown; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub _any_tests_failed { |
342
|
29
|
|
|
29
|
|
207
|
my $failed = 0; |
343
|
29
|
|
|
|
|
125
|
my $builder = Test::Builder->new; |
344
|
22
|
|
|
|
|
188
|
my @summary = $builder->summary; |
345
|
22
|
|
|
|
|
437
|
foreach my $passed ( |
346
|
|
|
|
|
|
|
@summary[ $builder->{'Test::Aggregate::Builder'}{last_test} |
347
|
|
|
|
|
|
|
.. |
348
|
|
|
|
|
|
|
$builder->current_test - 1 ] |
349
|
|
|
|
|
|
|
) { |
350
|
38
|
50
|
|
|
|
368
|
if (not $passed) { |
351
|
0
|
|
|
|
|
0
|
$failed = 1; |
352
|
0
|
|
|
|
|
0
|
last; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
} |
355
|
22
|
|
|
|
|
66
|
return $failed; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub run_this_test_program { |
359
|
23
|
|
|
23
|
0
|
94
|
my $builder = Test::Builder->new; |
360
|
23
|
|
|
|
|
153
|
my ( $package, $test, $current_test, $num_tests, $verbose ) = @_; |
361
|
23
|
50
|
|
|
|
90
|
Test::More::diag("******** running tests for $test ********") if $ENV{TEST_VERBOSE}; |
362
|
23
|
|
|
|
|
43
|
my $error = eval { |
363
|
23
|
100
|
|
|
|
131
|
if ( my $reason = $builder->{'Test::Aggregate::Builder'}{skip_all}{$package} ) { |
364
|
2
|
|
|
|
|
8
|
$builder->skip($reason); |
365
|
2
|
|
|
|
|
533
|
return; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
else { |
368
|
21
|
|
|
|
|
38
|
local $@; |
369
|
|
|
|
|
|
|
# localize some popular globals |
370
|
10
|
|
|
10
|
|
57
|
no warnings 'uninitialized'; |
|
10
|
|
|
|
|
15
|
|
|
10
|
|
|
|
|
1103
|
|
371
|
21
|
|
|
|
|
1091
|
local %ENV = %ENV; |
372
|
21
|
|
|
|
|
165
|
local $/ = $/; |
373
|
21
|
|
|
|
|
127
|
local @INC = @INC; |
374
|
21
|
|
|
|
|
40
|
local $_ = $_; |
375
|
21
|
|
|
|
|
87
|
local $| = $|; |
376
|
21
|
|
|
|
|
8127
|
local %SIG = %SIG; |
377
|
10
|
|
|
10
|
|
48
|
use warnings 'uninitialized'; |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
13370
|
|
378
|
21
|
|
|
|
|
293
|
$builder->{'Test::Aggregate::Builder'}{file_for}{$package} = $test; |
379
|
21
|
|
|
|
|
77
|
local $builder->{'Test::Aggregate::Builder'}{running} = $package; |
380
|
21
|
|
|
|
|
44
|
eval { $package->run_the_tests }; |
|
21
|
|
|
|
|
373
|
|
381
|
20
|
100
|
100
|
|
|
7994
|
if ($@ && ref($@) && $@ == $Test::Aggregate::Builder::skip) { |
|
|
|
66
|
|
|
|
|
382
|
2
|
|
|
|
|
12
|
$builder->skip( $builder->{'Test::Aggregate::Builder'}{skip_all}{$package} ); |
383
|
2
|
|
|
|
|
630
|
return; |
384
|
|
|
|
|
|
|
} |
385
|
18
|
|
|
|
|
1217
|
$@; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
}; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
{ |
390
|
22
|
|
|
|
|
52
|
my $test_name = "$test ($current_test out of $num_tests)"; |
|
22
|
|
|
|
|
91
|
|
391
|
22
|
|
|
|
|
80
|
my $failed = _any_tests_failed(); |
392
|
22
|
100
|
|
|
|
104
|
chomp $error if defined $error; |
393
|
22
|
|
66
|
|
|
71
|
$error &&= "($error)"; |
394
|
22
|
100
|
66
|
|
|
269
|
my $ok = $failed || $error |
395
|
|
|
|
|
|
|
? "not ok - $test_name $error" |
396
|
|
|
|
|
|
|
: " ok - $test_name"; |
397
|
|
|
|
|
|
|
# don't diag if verbose is zero |
398
|
22
|
100
|
|
|
|
65
|
if( $verbose ){ |
399
|
1
|
0
|
33
|
|
|
8
|
Test::More::diag($ok) if $error or $failed or $verbose == $VERBOSE{all}; |
|
|
|
33
|
|
|
|
|
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
# but do register as a failure |
402
|
22
|
100
|
66
|
|
|
175
|
if ($error or $failed) { |
403
|
1
|
|
|
|
|
5
|
Test::More::ok(0, "Error running ($test): $error"); |
404
|
|
|
|
|
|
|
# XXX this should be fine since these keys are not actually used |
405
|
|
|
|
|
|
|
# internally. |
406
|
1
|
|
|
|
|
239
|
$builder->{XXX_test_failed} = 0; |
407
|
1
|
|
|
|
|
4
|
$builder->{TEST_MOST_test_failed} = 0; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
} |
410
|
22
|
|
|
|
|
86
|
$builder->{'Test::Aggregate::Builder'}{last_test} = $builder->current_test; |
411
|
|
|
|
|
|
|
|
412
|
22
|
100
|
|
|
|
239
|
return unless $error; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
sub _build_aggregate_code { |
416
|
8
|
|
|
8
|
|
27
|
my ( $self, @tests ) = @_; |
417
|
8
|
|
|
|
|
38
|
my $code = "\n# Built from $0\n"; |
418
|
8
|
|
|
|
|
36
|
$code .= $self->_test_builder_override; |
419
|
|
|
|
|
|
|
|
420
|
8
|
|
|
|
|
40
|
my ( $startup, $startup_code ) = $self->_as_code('startup'); |
421
|
8
|
|
|
|
|
28
|
my ( $shutdown, $shutdown_code ) = $self->_as_code('shutdown'); |
422
|
8
|
|
|
|
|
32
|
my ( $setup, $setup_code ) = $self->_as_code('setup'); |
423
|
8
|
|
|
|
|
26
|
my ( $teardown, $teardown_code ) = $self->_as_code('teardown'); |
424
|
|
|
|
|
|
|
|
425
|
8
|
|
|
|
|
31
|
my $verbose = $self->_verbose; |
426
|
8
|
|
|
|
|
17
|
my $findbin; |
427
|
8
|
50
|
|
|
|
46
|
if ( $self->_findbin ) { |
428
|
8
|
|
|
|
|
15
|
$findbin = <<' END_CODE'; |
429
|
|
|
|
|
|
|
use FindBin; |
430
|
|
|
|
|
|
|
my $REINIT_FINDBIN = FindBin->can(q/again/) || sub {}; |
431
|
|
|
|
|
|
|
END_CODE |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
else { |
434
|
0
|
|
|
|
|
0
|
$findbin = 'my $REINIT_FINDBIN = sub {};'; |
435
|
|
|
|
|
|
|
} |
436
|
8
|
|
|
|
|
45
|
$code .= <<" END_CODE"; |
437
|
|
|
|
|
|
|
$startup_code |
438
|
|
|
|
|
|
|
$shutdown_code |
439
|
|
|
|
|
|
|
$setup_code |
440
|
|
|
|
|
|
|
$teardown_code |
441
|
|
|
|
|
|
|
$findbin |
442
|
|
|
|
|
|
|
END_CODE |
443
|
|
|
|
|
|
|
|
444
|
8
|
|
|
|
|
15
|
my @packages; |
445
|
8
|
|
|
|
|
20
|
my $separator = '#' x 20; |
446
|
|
|
|
|
|
|
|
447
|
8
|
|
|
|
|
16
|
my $test_packages = ''; |
448
|
|
|
|
|
|
|
|
449
|
8
|
|
|
|
|
46
|
my $dump = $self->_dump; |
450
|
|
|
|
|
|
|
|
451
|
8
|
|
|
|
|
39
|
$code .= "if ( __FILE__ eq '$dump' ) {\n"; |
452
|
|
|
|
|
|
|
|
453
|
8
|
100
|
|
|
|
27
|
if ( $startup ) { |
454
|
1
|
|
|
|
|
5
|
$code .= " $startup->() if __FILE__ eq '$dump';\n"; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
8
|
|
|
|
|
18
|
my $current_test = 0; |
458
|
8
|
|
|
|
|
17
|
my $total_tests = @tests; |
459
|
8
|
|
|
|
|
24
|
foreach my $test (@tests) { |
460
|
24
|
|
|
|
|
31
|
$current_test++; |
461
|
24
|
|
|
|
|
67
|
my $test_code = $self->_slurp($test); |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
# get rid of hashbangs as Perl::Tidy gets all huffy-like and we |
464
|
|
|
|
|
|
|
# disregard them anyway. |
465
|
23
|
|
|
|
|
103
|
$test_code =~ s/\A#![^\n]+//gm; |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
# Strip __END__ and __DATA__ if there's nothing after it. |
468
|
|
|
|
|
|
|
# XXX leaving this out for now as I'm unsure if it's worth it. |
469
|
|
|
|
|
|
|
#$test_code =~ s/\n__(?:DATA|END)__\n$//s; |
470
|
|
|
|
|
|
|
|
471
|
23
|
50
|
|
|
|
73
|
if ( $test_code =~ /^(__(?:DATA|END)__)/m ) { |
472
|
0
|
|
|
|
|
0
|
Test::More::BAIL_OUT("Test $test not allowed to have $1 token (Test::Aggregate::Nested supports them)"); |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
23
|
|
|
|
|
104
|
my $package = $self->_get_package($test); |
476
|
23
|
|
|
|
|
33
|
push @{ $self->{_packages} } => [ $test, $package ]; |
|
23
|
|
|
|
|
73
|
|
477
|
23
|
100
|
|
|
|
74
|
if ( $setup ) { |
478
|
10
|
|
|
|
|
28
|
$code .= " $setup->('$test');\n"; |
479
|
|
|
|
|
|
|
} |
480
|
23
|
|
|
|
|
103
|
$code .= qq{ run_this_test_program( $package => '$test', $current_test, $total_tests, $verbose );}; |
481
|
|
|
|
|
|
|
|
482
|
23
|
100
|
|
|
|
47
|
if ( $teardown ) { |
483
|
9
|
|
|
|
|
28
|
$code .= " $teardown->('$test');\n"; |
484
|
|
|
|
|
|
|
} |
485
|
23
|
|
|
|
|
35
|
$code .= "\n"; |
486
|
|
|
|
|
|
|
|
487
|
23
|
50
|
|
|
|
86
|
my $set_filenames = $self->_set_filenames |
488
|
|
|
|
|
|
|
? "local \$0 = '$test';" |
489
|
|
|
|
|
|
|
: ''; |
490
|
|
|
|
|
|
|
|
491
|
23
|
|
|
|
|
140
|
$test_packages .= <<" END_CODE"; |
492
|
|
|
|
|
|
|
{ |
493
|
|
|
|
|
|
|
$separator beginning of $test $separator |
494
|
|
|
|
|
|
|
package $package; |
495
|
|
|
|
|
|
|
sub run_the_tests { |
496
|
|
|
|
|
|
|
$set_filenames |
497
|
|
|
|
|
|
|
\$REINIT_FINDBIN->(); |
498
|
|
|
|
|
|
|
# line 1 "$test" |
499
|
|
|
|
|
|
|
$test_code |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
$separator end of $test $separator |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
END_CODE |
504
|
|
|
|
|
|
|
} |
505
|
7
|
100
|
|
|
|
53
|
if ( $shutdown ) { |
506
|
1
|
|
|
|
|
4
|
$code .= " $shutdown->() if __FILE__ eq '$dump';\n"; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
7
|
|
|
|
|
14
|
$code .= "}\n"; |
510
|
7
|
|
|
|
|
52
|
$code .= $test_packages; |
511
|
7
|
50
|
|
|
|
49
|
if ( my $tidy = $self->_tidy ) { |
512
|
0
|
|
|
|
|
0
|
eval "use Perl::Tidy"; |
513
|
0
|
|
|
|
|
0
|
my $error = $@; |
514
|
0
|
|
|
|
|
0
|
my $dump = $self->_dump; |
515
|
0
|
0
|
0
|
|
|
0
|
if ( $error && $dump ) { |
|
|
0
|
|
|
|
|
|
516
|
0
|
|
|
|
|
0
|
warn "Cannot tidy dumped code: $error"; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
elsif ( !$error ) { |
519
|
0
|
|
|
|
|
0
|
my @output; |
520
|
0
|
0
|
|
|
|
0
|
my @tidyrc = -f $tidy |
521
|
|
|
|
|
|
|
? ( perltidyrc => $tidy ) |
522
|
|
|
|
|
|
|
: (); |
523
|
0
|
|
|
|
|
0
|
Perl::Tidy::perltidy( |
524
|
|
|
|
|
|
|
source => \$code, |
525
|
|
|
|
|
|
|
destination => \@output, |
526
|
|
|
|
|
|
|
@tidyrc, |
527
|
|
|
|
|
|
|
); |
528
|
0
|
|
|
|
|
0
|
$code = join '' => @output; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
} |
531
|
7
|
|
|
|
|
28
|
return $code; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
sub _as_code { |
535
|
32
|
|
|
32
|
|
62
|
my ( $self, $name ) = @_; |
536
|
32
|
|
|
|
|
53
|
my $method = "_$name"; |
537
|
32
|
50
|
|
|
|
150
|
return ( '', '' ) if $self->_no_streamer; |
538
|
32
|
|
100
|
|
|
211
|
my $code = $self->$method || return ( '', '' ); |
539
|
6
|
|
|
|
|
21
|
$code = Data::Dump::Streamer::Dump($code)->Indent(0)->Out; |
540
|
6
|
|
|
|
|
14044
|
my $sub_name = "\$TEST_AGGREGATE_\U$name"; |
541
|
6
|
|
|
|
|
162
|
$code =~ s/\$CODE1/$sub_name/; |
542
|
6
|
|
|
|
|
29
|
return ( $sub_name, <<" END_CODE" ); |
543
|
|
|
|
|
|
|
my $sub_name; |
544
|
|
|
|
|
|
|
{ |
545
|
|
|
|
|
|
|
$code |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
END_CODE |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
sub _slurp { |
551
|
24
|
|
|
24
|
|
36
|
my ( $class, $file ) = @_; |
552
|
24
|
|
|
|
|
52
|
local *FH; |
553
|
24
|
100
|
|
|
|
938
|
open FH, "< $file" or die "Cannot read ($file): $!"; |
554
|
23
|
|
|
|
|
42
|
return do { local $/; <FH> }; |
|
23
|
|
|
|
|
61
|
|
|
23
|
|
|
|
|
607
|
|
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
sub _test_builder_override { |
558
|
8
|
|
|
8
|
|
18
|
my $self = shift; |
559
|
|
|
|
|
|
|
|
560
|
8
|
|
|
|
|
22
|
my $disable_test_nowarnings = ''; |
561
|
8
|
50
|
|
|
|
57
|
if ( !$self->_test_nowarnings ) { |
562
|
0
|
|
|
|
|
0
|
$disable_test_nowarnings = <<' END_CODE'; |
563
|
|
|
|
|
|
|
# Look ma, no import! |
564
|
|
|
|
|
|
|
BEGIN { |
565
|
|
|
|
|
|
|
require Test::NoWarnings; |
566
|
|
|
|
|
|
|
no warnings 'redefine'; |
567
|
|
|
|
|
|
|
*Test::NoWarnings::had_no_warnings = sub { }; |
568
|
|
|
|
|
|
|
*Test::NoWarnings::import = sub { |
569
|
|
|
|
|
|
|
my $callpack = caller(); |
570
|
|
|
|
|
|
|
my $ta_builder = $BUILDER->{'Test::Aggregate::Builder'}; |
571
|
|
|
|
|
|
|
if ( $ta_builder->{plan_for}{$callpack} ) { |
572
|
|
|
|
|
|
|
$ta_builder->{plan_for}{$callpack}--; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
$ta_builder->{test_nowarnings_loaded}{$callpack} = 1; |
575
|
|
|
|
|
|
|
}; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
END_CODE |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
|
580
|
8
|
|
|
|
|
42
|
return <<" END_CODE"; |
581
|
|
|
|
|
|
|
use Test::Aggregate; |
582
|
|
|
|
|
|
|
use Test::Aggregate::Builder; |
583
|
|
|
|
|
|
|
my \$BUILDER; |
584
|
|
|
|
|
|
|
BEGIN { |
585
|
|
|
|
|
|
|
\$BUILDER = Test::Builder->new; |
586
|
|
|
|
|
|
|
}; |
587
|
|
|
|
|
|
|
$disable_test_nowarnings; |
588
|
|
|
|
|
|
|
END_CODE |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
=head1 SETUP/TEARDOWN |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
Since C<BEGIN> and C<END> blocks are for the entire aggregated tests and not |
594
|
|
|
|
|
|
|
for each test program (see C<CAVEATS>), you might find that you need to have |
595
|
|
|
|
|
|
|
setup/teardown functions for tests. These are useful if you need to setup |
596
|
|
|
|
|
|
|
connections to test databases, clear out temp files, or any of a variety of |
597
|
|
|
|
|
|
|
tasks that your test suite might require. Here's a somewhat useless example, |
598
|
|
|
|
|
|
|
pulled from our tests: |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
#!/usr/bin/perl |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
use strict; |
603
|
|
|
|
|
|
|
use warnings; |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
use lib 'lib', 't/lib'; |
606
|
|
|
|
|
|
|
use Test::Aggregate; |
607
|
|
|
|
|
|
|
use Test::More; |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
my $dump = 'dump.t'; |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
my ( $startup, $shutdown ) = ( 0, 0 ); |
612
|
|
|
|
|
|
|
my ( $setup, $teardown ) = ( 0, 0 ); |
613
|
|
|
|
|
|
|
my $tests = Test::Aggregate->new( |
614
|
|
|
|
|
|
|
{ |
615
|
|
|
|
|
|
|
dirs => 'aggtests', |
616
|
|
|
|
|
|
|
dump => $dump, |
617
|
|
|
|
|
|
|
startup => sub { $startup++ }, |
618
|
|
|
|
|
|
|
shutdown => sub { $shutdown++ }, |
619
|
|
|
|
|
|
|
setup => sub { $setup++ }, |
620
|
|
|
|
|
|
|
teardown => sub { $teardown++ }, |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
); |
623
|
|
|
|
|
|
|
$tests->run; |
624
|
|
|
|
|
|
|
is $startup, 1, 'Startup should be called once'; |
625
|
|
|
|
|
|
|
is $shutdown, 1, '... as should shutdown'; |
626
|
|
|
|
|
|
|
is $setup, 4, 'Setup should be called once for each test program'; |
627
|
|
|
|
|
|
|
is $teardown, 4, '... as should teardown'; |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Note that you can still dump these to a dump file. This will only work if |
630
|
|
|
|
|
|
|
C<Data::Dump::Streamer> 1.11 or later is installed. |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
There are four attributes which can be passed to the constructor, each of |
633
|
|
|
|
|
|
|
which expects a code reference: |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=over 4 |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=item * C<startup> |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
startup => \&connect_to_database, |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
This function will be called before any of the tests are run. It is not run |
642
|
|
|
|
|
|
|
in a BEGIN block. |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=item * C<shutdown> |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
shutdown => \&clean_up_temp_files, |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
This function will be called after all of the tests are run. It will not be |
649
|
|
|
|
|
|
|
called in an END block. |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=item * C<setup> |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
setup => sub { |
654
|
|
|
|
|
|
|
my $filename = shift; |
655
|
|
|
|
|
|
|
# this gets run before each test program. |
656
|
|
|
|
|
|
|
}, |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
The setup function will be run before every test program. The name of the |
659
|
|
|
|
|
|
|
test file will be passed as the first argument. |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
=item * C<teardown> |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
teardown => sub { |
664
|
|
|
|
|
|
|
my $filename = shift; |
665
|
|
|
|
|
|
|
# this gets run after every test program. |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
The teardown function gets run after every test program. The name of the test |
669
|
|
|
|
|
|
|
file will be passed as the first argument. |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=back |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
=head1 GLOBAL VARIABLES |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
You shouldn't be using global variables and a dependence on them can break |
676
|
|
|
|
|
|
|
your code. However, Perl provides quite a few handy global variables which, |
677
|
|
|
|
|
|
|
unfortunately, can easily break your tests if you change them in one test and |
678
|
|
|
|
|
|
|
another assumes an unchanged value. As a result, we localize many of Perl's |
679
|
|
|
|
|
|
|
most common global variables for you, using the following syntax: |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
local %ENV = %ENV; |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
The following global variables are localized for you. Any others must be |
684
|
|
|
|
|
|
|
localized manually per test. |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=over 4 |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=item * C<@INC> |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=item * C<%ENV> |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=item * C<%SIG> |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
=item * C<$/> |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
=item * C<$_> |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=item * C<$|> |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=back |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
=head1 CAVEATS |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Not all tests can be included with this technique. If you have C<Test::Class> |
705
|
|
|
|
|
|
|
tests, there is no need to run them with this. Otherwise: |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=over 4 |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=item * C<exit> |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
Don't call exit() in your aggregated tests. We now warn very verbosely if |
712
|
|
|
|
|
|
|
this is done, but we still exit on the assumption that further tests cannot |
713
|
|
|
|
|
|
|
run. |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=item * C<__END__> and C<__DATA__> tokens. |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
These won't work and the tests will call BAIL_OUT() if these tokens are seen. |
718
|
|
|
|
|
|
|
However, this limitation does not apply to L<Test::Aggregate::Nested>. |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=item * C<BEGIN> and C<END> blocks. |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Since all of the tests are aggregated together, C<BEGIN> and C<END> blocks |
723
|
|
|
|
|
|
|
will be for the scope of the entire set of aggregated tests. If you need |
724
|
|
|
|
|
|
|
setup/teardown facilities, see L<SETUP/TEARDOWN>. |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=item * Syntax errors |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
Any syntax errors encountered will cause this program to BAIL_OUT(). This is |
729
|
|
|
|
|
|
|
why it's recommended that you move your tests into your new directory one at a |
730
|
|
|
|
|
|
|
time: it makes it easier to figure out which one has caused the problem. |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=item * C<no_plan> |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
Unfortunately, due to how this works, the plan is always C<no_plan>. |
735
|
|
|
|
|
|
|
L<http://groups.google.com/group/perl.qa/browse_thread/thread/d58c49db734844f4/cd18996391acc601?#cd18996391acc601> |
736
|
|
|
|
|
|
|
for more information. |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
=item * C<Test::NoWarnings> |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
Great module. It loves to break aggregated tests since some might have |
741
|
|
|
|
|
|
|
warnings when others will not. You can disable it like this: |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
my $tests = Test::Aggregate->new( |
744
|
|
|
|
|
|
|
dirs => 'aggtests/', |
745
|
|
|
|
|
|
|
startup => sub { $INC{'Test/NoWarnings.pm'} = 1 }, |
746
|
|
|
|
|
|
|
); |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
As an alternative, you can also disable it with: |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
my $tests = Test::Aggregate->new({ |
751
|
|
|
|
|
|
|
dirs => 'aggtests', |
752
|
|
|
|
|
|
|
test_nowarnings => 0, |
753
|
|
|
|
|
|
|
}); |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
We do work internally to subtract the extra test added by C<Test::NoWarnings>. |
756
|
|
|
|
|
|
|
It's painful and experimental. Good luck. |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=item * C<Variable "$x" will not stay shared at (eval ...> |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
Because each test is wrapped in a method call, any of your subs which access a |
761
|
|
|
|
|
|
|
variable in an outer scope will likely throw the above warning. Pass in |
762
|
|
|
|
|
|
|
arguments explicitly to suppress this. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
Instead of: |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
my $x = 17; |
767
|
|
|
|
|
|
|
sub foo { |
768
|
|
|
|
|
|
|
my $y = shift; |
769
|
|
|
|
|
|
|
return $y + $x; |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
Write this: |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
my $x = 17; |
775
|
|
|
|
|
|
|
sub foo { |
776
|
|
|
|
|
|
|
my ( $y, $x ) = @_; |
777
|
|
|
|
|
|
|
return $y + $x; |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
However, consider L<Test::Aggregate::Nested>. This warning does not apply |
781
|
|
|
|
|
|
|
with that module. |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=item * Singletons |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
Be very careful of code which loads singletons. Oftimes those singletons in |
786
|
|
|
|
|
|
|
test suites may be altered for testing purposes, but later attempts to use |
787
|
|
|
|
|
|
|
those singletons can fail dramatically as they're not expecting the |
788
|
|
|
|
|
|
|
alterations. (Your author has painfully learned this lesson with database |
789
|
|
|
|
|
|
|
connections). |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=back |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
=head1 DEBUGGING AGGREGATE TESTS |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
Before aggregating tests, make sure that you add tests B<one at a time> to the |
796
|
|
|
|
|
|
|
aggregated test directory. Attempting to add many tests to the directory at |
797
|
|
|
|
|
|
|
once and then experiencing a failure means it will be much harder to track |
798
|
|
|
|
|
|
|
down which tests caused the failure. |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
Debugging aggregated tests which fail is a multi-step process. Let's say the |
801
|
|
|
|
|
|
|
following fails: |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
my $tests = Test::Aggregate->new( |
804
|
|
|
|
|
|
|
{ |
805
|
|
|
|
|
|
|
dump => 'dump.t', |
806
|
|
|
|
|
|
|
shuffle => 1, |
807
|
|
|
|
|
|
|
dirs => 'aggtests', |
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
); |
810
|
|
|
|
|
|
|
$tests->run; |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
=head2 Manually run the tests |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
The first step is to manually run all of the tests in the C<aggtests> dir. |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
prove -r aggtests/ |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
If the failures appear the same, fix them just like you would fix any other |
819
|
|
|
|
|
|
|
test failure and then rerun the C<Test::Aggregate> code. |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
Sometimes this means that a different number of tests run from what the |
822
|
|
|
|
|
|
|
aggregted tests run. Look for code which ends the program prematurely, such |
823
|
|
|
|
|
|
|
as an exception or an C<exit> statement. |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=head2 Run a dump file |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
If this does not fix your problem, create a dump file by passing |
828
|
|
|
|
|
|
|
C<< dump => $dumpfile >> to the constructor (as in the above example). Then |
829
|
|
|
|
|
|
|
try running this dumpfile directly to attempt to replicate the error: |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
prove -r $dumpfile |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=head2 Tweaking the dump file |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
Assuming the error has been replicated, open up the dump file. The beginning |
836
|
|
|
|
|
|
|
of the dump file will have some code which overrides some C<Test::Builder> |
837
|
|
|
|
|
|
|
internals. After that, you'll see the code which runs the tests. It will |
838
|
|
|
|
|
|
|
look similar to this: |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
if ( __FILE__ eq 'dump.t' ) { |
841
|
|
|
|
|
|
|
Test::More::diag("******** running tests for aggtests/boilerplate.t ********") |
842
|
|
|
|
|
|
|
if $ENV{TEST_VERBOSE}; |
843
|
|
|
|
|
|
|
aggtestsboilerplatet->run_the_tests; |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
Test::More::diag("******** running tests for aggtests/subs.t ********") |
846
|
|
|
|
|
|
|
if $ENV{TEST_VERBOSE}; |
847
|
|
|
|
|
|
|
aggtestssubst->run_the_tests; |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
Test::More::diag("******** running tests for aggtests/00-load.t ********") |
850
|
|
|
|
|
|
|
if $ENV{TEST_VERBOSE}; |
851
|
|
|
|
|
|
|
aggtests00loadt->run_the_tests; |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
Test::More::diag("******** running tests for aggtests/slow_load.t ********") |
854
|
|
|
|
|
|
|
if $ENV{TEST_VERBOSE}; |
855
|
|
|
|
|
|
|
aggtestsslow_loadt->run_the_tests; |
856
|
|
|
|
|
|
|
} |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
You can try to narrow down the problem by commenting out all of the |
859
|
|
|
|
|
|
|
C<run_the_tests> lines and gradually reintroducing them until you can figure |
860
|
|
|
|
|
|
|
out which one is actually causing the failure. |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=head1 COMMON PITFALLS |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=head2 My Tests Threw an Exception But Passed Anyway! |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
This really isn't a C<Test::Aggregate> problem so much as a general Perl |
867
|
|
|
|
|
|
|
problem. For each test file, C<Test::Aggregate> wraps the tests in an eval |
868
|
|
|
|
|
|
|
and checks C<< my $error = $@ >>. Unfortunately, we sometimes get code like |
869
|
|
|
|
|
|
|
this: |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
$server->ip_address('apple'); |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
And internally, the 'Server' class throws an exception but uses its own evals |
874
|
|
|
|
|
|
|
in a C<DESTROY> block (or something similar) to trap it. If the code you call |
875
|
|
|
|
|
|
|
uses an eval but fails to localize it, it wipes out I<your> eval. Neat, eh? |
876
|
|
|
|
|
|
|
Thus, you never get a chance to see the error. For various reasons, this |
877
|
|
|
|
|
|
|
tends to impact C<Test::Aggregate> when a C<DESTROY> block is triggered and |
878
|
|
|
|
|
|
|
calls code which internally uses eval (e.g., C<DBIx::Class>). You can often |
879
|
|
|
|
|
|
|
fix this with: |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
DESTROY { |
882
|
|
|
|
|
|
|
local $@ = $@; # localize but preserve the value |
883
|
|
|
|
|
|
|
my $self = shift; |
884
|
|
|
|
|
|
|
# do whatever you want |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=head2 C<BEGIN> and C<END> blocks |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
Remember that since the tests are now being run at once, these blocks will no |
890
|
|
|
|
|
|
|
longer run on a per-test basis, but will run for the entire aggregated set of |
891
|
|
|
|
|
|
|
tests. You may need to examine these individually to determine the problem. |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=head2 C<CHECK> and C<INIT> blocks. |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
Sorry, but you can't use these (just as in modperl). See L<perlmod> for more |
896
|
|
|
|
|
|
|
information about them and why they won't work. |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=head2 C<Test::NoWarnings> |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
This is a great test module. When aggregating tests together, however, it can |
901
|
|
|
|
|
|
|
cause pain as you'll often discover warnings that you never new existed. For |
902
|
|
|
|
|
|
|
a quick fix, add this before you attempt to run your tests: |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
$INC{'Test/NoWarnings.pm'} = 1; |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
That will disable C<Test::NoWarnings>, but you'll want to go in later to fix |
907
|
|
|
|
|
|
|
them. |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=head2 Paths |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
Many tests make assumptions about the paths to files and moving them into a |
912
|
|
|
|
|
|
|
new test directory can break this. |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=head2 C<$0> |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
Tests which use C<$0> can be problematic as the code is run in an C<eval> |
917
|
|
|
|
|
|
|
through C<Test::Aggregate> and C<$0> may not match expectations. This also |
918
|
|
|
|
|
|
|
means that it can behave differently if run directly from a dump file. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
As it turns out, you can assign to C<$0>! We do this by default and set the |
921
|
|
|
|
|
|
|
C<$0> to the correct filename. If you don't want this behavior, pass |
922
|
|
|
|
|
|
|
C<< set_filenames => 0 >> to the constructor. |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=head2 Minimal test case |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
If you cannot solve the problem, feel free to try and create a minimal test |
927
|
|
|
|
|
|
|
case and send it to me (assuming it's something I can run). |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
=head1 AUTHOR |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
Curtis Poe, C<< <ovid at cpan.org> >> |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=head1 BUGS |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
936
|
|
|
|
|
|
|
C<bug-test-aggregate at rt.cpan.org>, or through the web interface at |
937
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Aggregate>. |
938
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
939
|
|
|
|
|
|
|
your bug as I make changes. |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=head1 SUPPORT |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
perldoc Test::Aggregate |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
You can also find information oneline: |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
L<http://metacpan.org/release/Test-Aggregate> |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
Many thanks to mauzo (L<http://use.perl.org/~mauzo/> for helping me find the |
954
|
|
|
|
|
|
|
'skip_all' bug. |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
Thanks to Johan Lindström for pointing me to Apache::Registry. |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Copyright 2007 Curtis "Ovid" Poe, all rights reserved. |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
963
|
|
|
|
|
|
|
under the same terms as Perl itself. |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
=cut |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
1; |