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';
76 foreach my $method ( keys %SUMMARY_METHOD_FOR ) {
77 next if 'total' eq $method;
82 ? @{ $self->{"descriptions_for_$method"} }
86 } # end install summary methods
90 $self->{parser_for} = {};
91 $self->{parse_order} = [];
92 foreach my $summary ( keys %SUMMARY_METHOD_FOR ) {
93 $self->{$summary} = 0;
94 next if 'total' eq $summary;
95 $self->{"descriptions_for_$summary"} = [];
100 ##############################################################################
102 =head2 Instance Methods
106 $aggregate->add( $description => $parser );
108 The C<$description> is usually a test file name (but only by
109 convention.) It is used as a unique identifier (see e.g.
110 L<"parsers">.) Reusing a description is a fatal error.
112 The C<$parser> is a L<TAP::Parser|TAP::Parser> object.
117 my ( $self, $description, $parser ) = @_;
118 if ( exists $self->{parser_for}{$description} ) {
119 $self->_croak( "You already have a parser for ($description)."
120 . " Perhaps you have run the same test twice." );
122 push @{ $self->{parse_order} } => $description;
123 $self->{parser_for}{$description} = $parser;
125 while ( my ( $summary, $method ) = each %SUMMARY_METHOD_FOR ) {
127 # Slightly nasty. Instead we should maybe have 'cooked' accessors
128 # for results that may be masked by the parser.
130 if ( $method eq 'exit' || $method eq 'wait' )
131 && $parser->ignore_exit;
133 if ( my $count = $parser->$method() ) {
134 $self->{$summary} += $count;
135 push @{ $self->{"descriptions_for_$summary"} } => $description;
142 ##############################################################################
146 my $count = $aggregate->parsers;
147 my @parsers = $aggregate->parsers;
148 my @parsers = $aggregate->parsers(@descriptions);
150 In scalar context without arguments, this method returns the number of parsers
151 aggregated. In list context without arguments, returns the parsers in the
152 order they were added.
154 If C<@descriptions> is given, these correspond to the keys used in each
155 call to the add() method. Returns an array of the requested parsers (in
156 the requested order) in list context or an array reference in scalar
159 Requesting an unknown identifier is a fatal error.
165 return $self->_get_parsers(@_) if @_;
166 my $descriptions = $self->{parse_order};
167 my @parsers = @{ $self->{parser_for} }{@$descriptions};
169 # Note: Because of the way context works, we must assign the parsers to
170 # the @parsers array or else this method does not work as documented.
175 my ( $self, @descriptions ) = @_;
177 foreach my $description (@descriptions) {
178 $self->_croak("A parser for ($description) could not be found")
179 unless exists $self->{parser_for}{$description};
180 push @parsers => $self->{parser_for}{$description};
182 return wantarray ? @parsers : \@parsers;
185 =head3 C<descriptions>
187 Get an array of descriptions in the order in which they were added to the aggregator.
191 sub descriptions { @{ shift->{parse_order} || [] } }
195 Call C<start> immediately before adding any results to the aggregator.
196 Among other times it records the start time for the test run.
202 $self->{start_time} = Benchmark->new;
207 Call C<stop> immediately after adding all test results to the aggregator.
213 $self->{end_time} = Benchmark->new;
218 Elapsed returns a L<Benchmark> object that represents the running time
219 of the aggregated tests. In order for C<elapsed> to be valid you must
220 call C<start> before running the tests and C<stop> immediately
230 q{Can't call elapsed without first calling start and then stop}
231 unless defined $self->{start_time} && defined $self->{end_time};
232 return timediff( $self->{end_time}, $self->{start_time} );
235 =head3 C<elapsed_timestr>
237 Returns a formatted string representing the runtime returned by
238 C<elapsed()>. This lets the caller not worry about Benchmark.
242 sub elapsed_timestr {
245 my $elapsed = $self->elapsed;
247 return timestr($elapsed);
252 Return true if all the tests passed and no parse errors were detected.
260 && $self->total == $self->passed
261 && !$self->has_errors;
266 Get a single word describing the status of the aggregated tests.
267 Depending on the outcome of the tests returns 'PASS', 'FAIL' or
268 'NOTESTS'. This token is understood by L<CPAN::Reporter>.
275 my $total = $self->total;
276 my $passed = $self->passed;
279 ( $self->has_errors || $total != $passed ) ? 'FAIL'
284 ##############################################################################
286 =head2 Summary methods
288 Each of the following methods will return the total number of corresponding
289 tests if called in scalar context. If called in list context, returns the
290 descriptions of the parsers which contain the corresponding tests (see C<add>
291 for an explanation of description.
313 For example, to find out how many tests unexpectedly succeeded (TODO tests
314 which passed when they shouldn't):
316 my $count = $aggregate->todo_passed;
317 my @descriptions = $aggregate->todo_passed;
319 Note that C<wait> and C<exit> are the totals of the wait and exit
320 statuses of each of the tests. These values are totalled only to provide
321 a true value if any of them are non-zero.
325 ##############################################################################
329 my $tests_run = $aggregate->total;
331 Returns the total number of tests run.
335 sub total { shift->{total} }
337 ##############################################################################
339 =head3 C<has_problems>
341 if ( $parser->has_problems ) {
345 Identical to C<has_errors>, but also returns true if any TODO tests
346 unexpectedly succeeded. This is more akin to "warnings".
352 return $self->todo_passed
353 || $self->has_errors;
356 ##############################################################################
360 if ( $parser->has_errors ) {
364 Returns true if I<any> of the parsers failed. This includes:
372 =item * Bad exit or wait status
382 || $self->parse_errors
387 ##############################################################################
389 =head3 C<todo_failed>
391 # deprecated in favor of 'todo_passed'. This method was horribly misnamed.
393 This was a badly misnamed method. It indicates which TODO tests unexpectedly
394 succeeded. Will now issue a warning and call C<todo_passed>.
400 '"todo_failed" is deprecated. Please use "todo_passed". See the docs.';