1 package TAP::Parser::Aggregator;
5 use vars qw($VERSION @ISA);
9 @ISA = qw(TAP::Object);
13 TAP::Parser::Aggregator - Aggregate TAP::Parser results
25 use TAP::Parser::Aggregator;
27 my $aggregate = TAP::Parser::Aggregator->new;
28 $aggregate->add( 't/00-load.t', $load_parser );
29 $aggregate->add( 't/10-lex.t', $lex_parser );
31 my $summary = <<'END_SUMMARY';
34 Unexpectedly succeeded: %s
37 scalar $aggregate->passed,
38 scalar $aggregate->failed,
39 scalar $aggregate->todo_passed;
43 C<TAP::Parser::Aggregator> collects parser objects and allows
44 reporting/querying their aggregate results.
52 my $aggregate = TAP::Parser::Aggregator->new;
54 Returns a new C<TAP::Parser::Aggregator> object.
58 # new() implementation supplied by TAP::Object
60 my %SUMMARY_METHOD_FOR;
62 BEGIN { # install summary methods
63 %SUMMARY_METHOD_FOR = map { $_ => $_ } qw(
74 $SUMMARY_METHOD_FOR{total} = 'tests_run';
75 $SUMMARY_METHOD_FOR{planned} = 'tests_planned';
77 foreach my $method ( keys %SUMMARY_METHOD_FOR ) {
78 next if 'total' eq $method;
83 ? @{ $self->{"descriptions_for_$method"} }
87 } # end install summary methods
91 $self->{parser_for} = {};
92 $self->{parse_order} = [];
93 foreach my $summary ( keys %SUMMARY_METHOD_FOR ) {
94 $self->{$summary} = 0;
95 next if 'total' eq $summary;
96 $self->{"descriptions_for_$summary"} = [];
101 ##############################################################################
103 =head2 Instance Methods
107 $aggregate->add( $description => $parser );
109 The C<$description> is usually a test file name (but only by
110 convention.) It is used as a unique identifier (see e.g.
111 L<"parsers">.) Reusing a description is a fatal error.
113 The C<$parser> is a L<TAP::Parser|TAP::Parser> object.
118 my ( $self, $description, $parser ) = @_;
119 if ( exists $self->{parser_for}{$description} ) {
120 $self->_croak( "You already have a parser for ($description)."
121 . " Perhaps you have run the same test twice." );
123 push @{ $self->{parse_order} } => $description;
124 $self->{parser_for}{$description} = $parser;
126 while ( my ( $summary, $method ) = each %SUMMARY_METHOD_FOR ) {
128 # Slightly nasty. Instead we should maybe have 'cooked' accessors
129 # for results that may be masked by the parser.
131 if ( $method eq 'exit' || $method eq 'wait' )
132 && $parser->ignore_exit;
134 if ( my $count = $parser->$method() ) {
135 $self->{$summary} += $count;
136 push @{ $self->{"descriptions_for_$summary"} } => $description;
143 ##############################################################################
147 my $count = $aggregate->parsers;
148 my @parsers = $aggregate->parsers;
149 my @parsers = $aggregate->parsers(@descriptions);
151 In scalar context without arguments, this method returns the number of parsers
152 aggregated. In list context without arguments, returns the parsers in the
153 order they were added.
155 If C<@descriptions> is given, these correspond to the keys used in each
156 call to the add() method. Returns an array of the requested parsers (in
157 the requested order) in list context or an array reference in scalar
160 Requesting an unknown identifier is a fatal error.
166 return $self->_get_parsers(@_) if @_;
167 my $descriptions = $self->{parse_order};
168 my @parsers = @{ $self->{parser_for} }{@$descriptions};
170 # Note: Because of the way context works, we must assign the parsers to
171 # the @parsers array or else this method does not work as documented.
176 my ( $self, @descriptions ) = @_;
178 foreach my $description (@descriptions) {
179 $self->_croak("A parser for ($description) could not be found")
180 unless exists $self->{parser_for}{$description};
181 push @parsers => $self->{parser_for}{$description};
183 return wantarray ? @parsers : \@parsers;
186 =head3 C<descriptions>
188 Get an array of descriptions in the order in which they were added to
193 sub descriptions { @{ shift->{parse_order} || [] } }
197 Call C<start> immediately before adding any results to the aggregator.
198 Among other times it records the start time for the test run.
204 $self->{start_time} = Benchmark->new;
209 Call C<stop> immediately after adding all test results to the aggregator.
215 $self->{end_time} = Benchmark->new;
220 Elapsed returns a L<Benchmark> object that represents the running time
221 of the aggregated tests. In order for C<elapsed> to be valid you must
222 call C<start> before running the tests and C<stop> immediately
232 q{Can't call elapsed without first calling start and then stop}
233 unless defined $self->{start_time} && defined $self->{end_time};
234 return timediff( $self->{end_time}, $self->{start_time} );
237 =head3 C<elapsed_timestr>
239 Returns a formatted string representing the runtime returned by
240 C<elapsed()>. This lets the caller not worry about Benchmark.
244 sub elapsed_timestr {
247 my $elapsed = $self->elapsed;
249 return timestr($elapsed);
254 Return true if all the tests passed and no parse errors were detected.
262 && $self->total == $self->passed
263 && !$self->has_errors;
268 Get a single word describing the status of the aggregated tests.
269 Depending on the outcome of the tests returns 'PASS', 'FAIL' or
270 'NOTESTS'. This token is understood by L<CPAN::Reporter>.
277 my $total = $self->total;
278 my $passed = $self->passed;
281 ( $self->has_errors || $total != $passed ) ? 'FAIL'
286 ##############################################################################
288 =head2 Summary methods
290 Each of the following methods will return the total number of corresponding
291 tests if called in scalar context. If called in list context, returns the
292 descriptions of the parsers which contain the corresponding tests (see C<add>
293 for an explanation of description.
317 For example, to find out how many tests unexpectedly succeeded (TODO tests
318 which passed when they shouldn't):
320 my $count = $aggregate->todo_passed;
321 my @descriptions = $aggregate->todo_passed;
323 Note that C<wait> and C<exit> are the totals of the wait and exit
324 statuses of each of the tests. These values are totalled only to provide
325 a true value if any of them are non-zero.
329 ##############################################################################
333 my $tests_run = $aggregate->total;
335 Returns the total number of tests run.
339 sub total { shift->{total} }
341 ##############################################################################
343 =head3 C<has_problems>
345 if ( $parser->has_problems ) {
349 Identical to C<has_errors>, but also returns true if any TODO tests
350 unexpectedly succeeded. This is more akin to "warnings".
356 return $self->todo_passed
357 || $self->has_errors;
360 ##############################################################################
364 if ( $parser->has_errors ) {
368 Returns true if I<any> of the parsers failed. This includes:
376 =item * Bad exit or wait status
386 || $self->parse_errors
391 ##############################################################################
393 =head3 C<todo_failed>
395 # deprecated in favor of 'todo_passed'. This method was horribly misnamed.
397 This was a badly misnamed method. It indicates which TODO tests unexpectedly
398 succeeded. Will now issue a warning and call C<todo_passed>.
404 '"todo_failed" is deprecated. Please use "todo_passed". See the docs.';