Commit | Line | Data |
---|---|---|
b965d173 NC |
1 | package TAP::Parser; |
2 | ||
3 | use strict; | |
4 | use vars qw($VERSION @ISA); | |
5 | ||
6 | use TAP::Base (); | |
7 | use TAP::Parser::Grammar (); | |
8 | use TAP::Parser::Result (); | |
9 | use TAP::Parser::Source (); | |
10 | use TAP::Parser::Source::Perl (); | |
11 | use TAP::Parser::Iterator (); | |
12 | use Carp (); | |
13 | ||
14 | @ISA = qw(TAP::Base); | |
15 | ||
16 | =head1 NAME | |
17 | ||
18 | TAP::Parser - Parse L<TAP|Test::Harness::TAP> output | |
19 | ||
20 | =head1 VERSION | |
21 | ||
69f36734 | 22 | Version 3.06 |
b965d173 NC |
23 | |
24 | =cut | |
25 | ||
69f36734 | 26 | $VERSION = '3.06'; |
b965d173 NC |
27 | |
28 | my $DEFAULT_TAP_VERSION = 12; | |
29 | my $MAX_TAP_VERSION = 13; | |
30 | ||
31 | $ENV{TAP_VERSION} = $MAX_TAP_VERSION; | |
32 | ||
33 | END { | |
34 | ||
35 | # For VMS. | |
36 | delete $ENV{TAP_VERSION}; | |
37 | } | |
38 | ||
39 | BEGIN { # making accessors | |
40 | foreach my $method ( | |
41 | qw( | |
42 | _stream | |
43 | _spool | |
44 | _grammar | |
45 | exec | |
46 | exit | |
47 | is_good_plan | |
48 | plan | |
49 | tests_planned | |
50 | tests_run | |
51 | wait | |
52 | version | |
53 | in_todo | |
54 | start_time | |
55 | end_time | |
56 | skip_all | |
57 | ) | |
58 | ) | |
59 | { | |
60 | no strict 'refs'; | |
61 | ||
62 | # another tiny performance hack | |
63 | if ( $method =~ /^_/ ) { | |
64 | *$method = sub { | |
65 | my $self = shift; | |
66 | return $self->{$method} unless @_; | |
67 | ||
68 | # Trusted methods | |
69 | unless ( ( ref $self ) =~ /^TAP::Parser/ ) { | |
70 | Carp::croak("$method() may not be set externally"); | |
71 | } | |
72 | ||
73 | $self->{$method} = shift; | |
74 | }; | |
75 | } | |
76 | else { | |
77 | *$method = sub { | |
78 | my $self = shift; | |
79 | return $self->{$method} unless @_; | |
80 | $self->{$method} = shift; | |
81 | }; | |
82 | } | |
83 | } | |
84 | } # done making accessors | |
85 | ||
86 | =head1 SYNOPSIS | |
87 | ||
88 | use TAP::Parser; | |
89 | ||
90 | my $parser = TAP::Parser->new( { source => $source } ); | |
91 | ||
92 | while ( my $result = $parser->next ) { | |
93 | print $result->as_string; | |
94 | } | |
95 | ||
96 | =head1 DESCRIPTION | |
97 | ||
98 | C<TAP::Parser> is designed to produce a proper parse of TAP output. For | |
99 | an example of how to run tests through this module, see the simple | |
100 | harnesses C<examples/>. | |
101 | ||
102 | There's a wiki dedicated to the Test Anything Protocol: | |
103 | ||
104 | L<http://testanything.org> | |
105 | ||
106 | It includes the TAP::Parser Cookbook: | |
107 | ||
108 | L<http://testanything.org/wiki/index.php/TAP::Parser_Cookbook> | |
109 | ||
110 | =head1 METHODS | |
111 | ||
112 | =head2 Class Methods | |
113 | ||
114 | =head3 C<new> | |
115 | ||
116 | my $parser = TAP::Parser->new(\%args); | |
117 | ||
118 | Returns a new C<TAP::Parser> object. | |
119 | ||
120 | The arguments should be a hashref with I<one> of the following keys: | |
121 | ||
122 | =over 4 | |
123 | ||
124 | =item * C<source> | |
125 | ||
126 | This is the preferred method of passing arguments to the constructor. To | |
127 | determine how to handle the source, the following steps are taken. | |
128 | ||
129 | If the source contains a newline, it's assumed to be a string of raw TAP | |
130 | output. | |
131 | ||
132 | If the source is a reference, it's assumed to be something to pass to | |
133 | the L<TAP::Parser::Iterator::Stream> constructor. This is used | |
134 | internally and you should not use it. | |
135 | ||
136 | Otherwise, the parser does a C<-e> check to see if the source exists. If so, | |
137 | it attempts to execute the source and read the output as a stream. This is by | |
138 | far the preferred method of using the parser. | |
139 | ||
140 | foreach my $file ( @test_files ) { | |
141 | my $parser = TAP::Parser->new( { source => $file } ); | |
142 | # do stuff with the parser | |
143 | } | |
144 | ||
145 | =item * C<tap> | |
146 | ||
147 | The value should be the complete TAP output. | |
148 | ||
149 | =item * C<exec> | |
150 | ||
151 | If passed an array reference, will attempt to create the iterator by | |
152 | passing a L<TAP::Parser::Source> object to | |
153 | L<TAP::Parser::Iterator::Source>, using the array reference strings as | |
154 | the command arguments to L<IPC::Open3::open3|IPC::Open3>: | |
155 | ||
156 | exec => [ '/usr/bin/ruby', 't/my_test.rb' ] | |
157 | ||
158 | Note that C<source> and C<exec> are mutually exclusive. | |
159 | ||
160 | =back | |
161 | ||
162 | The following keys are optional. | |
163 | ||
164 | =over 4 | |
165 | ||
166 | =item * C<callback> | |
167 | ||
168 | If present, each callback corresponding to a given result type will be called | |
169 | with the result as the argument if the C<run> method is used: | |
170 | ||
171 | my %callbacks = ( | |
172 | test => \&test_callback, | |
173 | plan => \&plan_callback, | |
174 | comment => \&comment_callback, | |
175 | bailout => \&bailout_callback, | |
176 | unknown => \&unknown_callback, | |
177 | ); | |
178 | ||
179 | my $aggregator = TAP::Parser::Aggregator->new; | |
180 | foreach my $file ( @test_files ) { | |
181 | my $parser = TAP::Parser->new( | |
182 | { | |
183 | source => $file, | |
184 | callbacks => \%callbacks, | |
185 | } | |
186 | ); | |
187 | $parser->run; | |
188 | $aggregator->add( $file, $parser ); | |
189 | } | |
190 | ||
191 | =item * C<switches> | |
192 | ||
193 | If using a Perl file as a source, optional switches may be passed which will | |
194 | be used when invoking the perl executable. | |
195 | ||
196 | my $parser = TAP::Parser->new( { | |
197 | source => $test_file, | |
198 | switches => '-Ilib', | |
199 | } ); | |
200 | ||
201 | =item * C<test_args> | |
202 | ||
203 | Used in conjunction with the C<source> option to supply a reference to | |
204 | an C<@ARGV> style array of arguments to pass to the test program. | |
205 | ||
206 | =item * C<spool> | |
207 | ||
208 | If passed a filehandle will write a copy of all parsed TAP to that handle. | |
209 | ||
210 | =item * C<merge> | |
211 | ||
212 | If false, STDERR is not captured (though it is 'relayed' to keep it | |
213 | somewhat synchronized with STDOUT.) | |
214 | ||
215 | If true, STDERR and STDOUT are the same filehandle. This may cause | |
216 | breakage if STDERR contains anything resembling TAP format, but does | |
217 | allow exact synchronization. | |
218 | ||
219 | Subtleties of this behavior may be platform-dependent and may change in | |
220 | the future. | |
221 | ||
222 | =back | |
223 | ||
224 | =cut | |
225 | ||
226 | # new implementation supplied by TAP::Base | |
227 | ||
228 | ############################################################################## | |
229 | ||
230 | =head2 Instance Methods | |
231 | ||
232 | =head3 C<next> | |
233 | ||
234 | my $parser = TAP::Parser->new( { source => $file } ); | |
235 | while ( my $result = $parser->next ) { | |
236 | print $result->as_string, "\n"; | |
237 | } | |
238 | ||
239 | This method returns the results of the parsing, one result at a time. Note | |
240 | that it is destructive. You can't rewind and examine previous results. | |
241 | ||
242 | If callbacks are used, they will be issued before this call returns. | |
243 | ||
244 | Each result returned is a subclass of L<TAP::Parser::Result>. See that | |
245 | module and related classes for more information on how to use them. | |
246 | ||
247 | =cut | |
248 | ||
249 | sub next { | |
250 | my $self = shift; | |
251 | return ( $self->{_iter} ||= $self->_iter )->(); | |
252 | } | |
253 | ||
254 | ############################################################################## | |
255 | ||
256 | =head3 C<run> | |
257 | ||
258 | $parser->run; | |
259 | ||
260 | This method merely runs the parser and parses all of the TAP. | |
261 | ||
262 | =cut | |
263 | ||
264 | sub run { | |
265 | my $self = shift; | |
266 | while ( defined( my $result = $self->next ) ) { | |
267 | ||
268 | # do nothing | |
269 | } | |
270 | } | |
271 | ||
272 | { | |
273 | ||
274 | # of the following, anything beginning with an underscore is strictly | |
275 | # internal and should not be exposed. | |
276 | my %initialize = ( | |
277 | version => $DEFAULT_TAP_VERSION, | |
278 | plan => '', # the test plan (e.g., 1..3) | |
279 | tap => '', # the TAP | |
280 | tests_run => 0, # actual current test numbers | |
281 | results => [], # TAP parser results | |
282 | skipped => [], # | |
283 | todo => [], # | |
284 | passed => [], # | |
285 | failed => [], # | |
286 | actual_failed => [], # how many tests really failed | |
287 | actual_passed => [], # how many tests really passed | |
288 | todo_passed => [], # tests which unexpectedly succeed | |
289 | parse_errors => [], # perfect TAP should have none | |
290 | ); | |
291 | ||
292 | # We seem to have this list hanging around all over the place. We could | |
293 | #Â probably get it from somewhere else to avoid the repetition. | |
294 | my @legal_callback = qw( | |
295 | test | |
296 | version | |
297 | plan | |
298 | comment | |
299 | bailout | |
300 | unknown | |
301 | yaml | |
302 | ALL | |
303 | ELSE | |
304 | EOF | |
305 | ); | |
306 | ||
307 | sub _initialize { | |
308 | my ( $self, $arg_for ) = @_; | |
309 | ||
310 | # everything here is basically designed to convert any TAP source to a | |
311 | # stream. | |
312 | ||
313 | # Shallow copy | |
314 | my %args = %{ $arg_for || {} }; | |
315 | ||
316 | $self->SUPER::_initialize( \%args, \@legal_callback ); | |
317 | ||
318 | my $stream = delete $args{stream}; | |
319 | my $tap = delete $args{tap}; | |
320 | my $source = delete $args{source}; | |
321 | my $exec = delete $args{exec}; | |
322 | my $merge = delete $args{merge}; | |
323 | my $spool = delete $args{spool}; | |
324 | my $switches = delete $args{switches}; | |
325 | my @test_args = @{ delete $args{test_args} || [] }; | |
326 | ||
327 | if ( 1 < grep {defined} $stream, $tap, $source, $exec ) { | |
328 | $self->_croak( | |
329 | "You may only choose one of 'exec', 'stream', 'tap' or 'source'" | |
330 | ); | |
331 | } | |
332 | ||
333 | if ( my @excess = sort keys %args ) { | |
334 | $self->_croak("Unknown options: @excess"); | |
335 | } | |
336 | ||
337 | if ($tap) { | |
338 | $stream = TAP::Parser::Iterator->new( [ split "\n" => $tap ] ); | |
339 | } | |
340 | elsif ($exec) { | |
341 | my $source = TAP::Parser::Source->new; | |
342 | $source->source( [ @$exec, @test_args ] ); | |
343 | $source->merge($merge); # XXX should just be arguments? | |
344 | $stream = $source->get_stream; | |
345 | } | |
346 | elsif ($source) { | |
347 | if ( my $ref = ref $source ) { | |
348 | $stream = TAP::Parser::Iterator->new($source); | |
349 | } | |
350 | elsif ( -e $source ) { | |
351 | ||
352 | my $perl = TAP::Parser::Source::Perl->new; | |
353 | ||
354 | $perl->switches($switches) | |
355 | if $switches; | |
356 | ||
357 | $perl->merge($merge); # XXX args to new()? | |
358 | ||
359 | $perl->source( [ $source, @test_args ] ); | |
360 | ||
361 | $stream = $perl->get_stream; | |
362 | } | |
363 | else { | |
364 | $self->_croak("Cannot determine source for $source"); | |
365 | } | |
366 | } | |
367 | ||
368 | unless ($stream) { | |
369 | $self->_croak('PANIC: could not determine stream'); | |
370 | } | |
371 | ||
372 | while ( my ( $k, $v ) = each %initialize ) { | |
373 | $self->{$k} = 'ARRAY' eq ref $v ? [] : $v; | |
374 | } | |
375 | ||
376 | $self->_stream($stream); | |
377 | my $grammar = TAP::Parser::Grammar->new($stream); | |
378 | $grammar->set_version( $self->version ); | |
379 | $self->_grammar($grammar); | |
380 | $self->_spool($spool); | |
381 | ||
382 | $self->start_time( $self->get_time ); | |
383 | ||
384 | return $self; | |
385 | } | |
386 | } | |
387 | ||
388 | =head1 INDIVIDUAL RESULTS | |
389 | ||
390 | If you've read this far in the docs, you've seen this: | |
391 | ||
392 | while ( my $result = $parser->next ) { | |
393 | print $result->as_string; | |
394 | } | |
395 | ||
396 | Each result returned is a L<TAP::Parser::Result> subclass, referred to as | |
397 | I<result types>. | |
398 | ||
399 | =head2 Result types | |
400 | ||
401 | Basically, you fetch individual results from the TAP. The six types, with | |
402 | examples of each, are as follows: | |
403 | ||
404 | =over 4 | |
405 | ||
406 | =item * Version | |
407 | ||
408 | TAP version 12 | |
409 | ||
410 | =item * Plan | |
411 | ||
412 | 1..42 | |
413 | ||
414 | =item * Test | |
415 | ||
416 | ok 3 - We should start with some foobar! | |
417 | ||
418 | =item * Comment | |
419 | ||
420 | # Hope we don't use up the foobar. | |
421 | ||
422 | =item * Bailout | |
423 | ||
424 | Bail out! We ran out of foobar! | |
425 | ||
426 | =item * Unknown | |
427 | ||
428 | ... yo, this ain't TAP! ... | |
429 | ||
430 | =back | |
431 | ||
432 | Each result fetched is a result object of a different type. There are common | |
433 | methods to each result object and different types may have methods unique to | |
434 | their type. Sometimes a type method may be overridden in a subclass, but its | |
435 | use is guaranteed to be identical. | |
436 | ||
437 | =head2 Common type methods | |
438 | ||
439 | =head3 C<type> | |
440 | ||
441 | Returns the type of result, such as C<comment> or C<test>. | |
442 | ||
443 | =head3 C<as_string> | |
444 | ||
445 | Prints a string representation of the token. This might not be the exact | |
446 | output, however. Tests will have test numbers added if not present, TODO and | |
447 | SKIP directives will be capitalized and, in general, things will be cleaned | |
448 | up. If you need the original text for the token, see the C<raw> method. | |
449 | ||
450 | =head3 C<raw> | |
451 | ||
452 | Returns the original line of text which was parsed. | |
453 | ||
454 | =head3 C<is_plan> | |
455 | ||
456 | Indicates whether or not this is the test plan line. | |
457 | ||
458 | =head3 C<is_test> | |
459 | ||
460 | Indicates whether or not this is a test line. | |
461 | ||
462 | =head3 C<is_comment> | |
463 | ||
464 | Indicates whether or not this is a comment. Comments will generally only | |
465 | appear in the TAP stream if STDERR is merged to STDOUT. See the | |
466 | C<merge> option. | |
467 | ||
468 | =head3 C<is_bailout> | |
469 | ||
470 | Indicates whether or not this is bailout line. | |
471 | ||
472 | =head3 C<is_yaml> | |
473 | ||
474 | Indicates whether or not the current item is a YAML block. | |
475 | ||
476 | =head3 C<is_unknown> | |
477 | ||
478 | Indicates whether or not the current line could be parsed. | |
479 | ||
480 | =head3 C<is_ok> | |
481 | ||
482 | if ( $result->is_ok ) { ... } | |
483 | ||
484 | Reports whether or not a given result has passed. Anything which is B<not> a | |
485 | test result returns true. This is merely provided as a convenient shortcut | |
486 | which allows you to do this: | |
487 | ||
488 | my $parser = TAP::Parser->new( { source => $source } ); | |
489 | while ( my $result = $parser->next ) { | |
490 | # only print failing results | |
491 | print $result->as_string unless $result->is_ok; | |
492 | } | |
493 | ||
494 | =head2 C<plan> methods | |
495 | ||
496 | if ( $result->is_plan ) { ... } | |
497 | ||
498 | If the above evaluates as true, the following methods will be available on the | |
499 | C<$result> object. | |
500 | ||
501 | =head3 C<plan> | |
502 | ||
503 | if ( $result->is_plan ) { | |
504 | print $result->plan; | |
505 | } | |
506 | ||
507 | This is merely a synonym for C<as_string>. | |
508 | ||
509 | =head3 C<tests_planned> | |
510 | ||
511 | my $planned = $result->tests_planned; | |
512 | ||
513 | Returns the number of tests planned. For example, a plan of C<1..17> will | |
514 | cause this method to return '17'. | |
515 | ||
516 | =head3 C<directive> | |
517 | ||
518 | my $directive = $result->directive; | |
519 | ||
520 | If a SKIP directive is included with the plan, this method will return it. | |
521 | ||
522 | 1..0 # SKIP: why bother? | |
523 | ||
524 | =head3 C<explanation> | |
525 | ||
526 | my $explanation = $result->explanation; | |
527 | ||
528 | If a SKIP directive was included with the plan, this method will return the | |
529 | explanation, if any. | |
530 | ||
531 | =head2 C<commment> methods | |
532 | ||
533 | if ( $result->is_comment ) { ... } | |
534 | ||
535 | If the above evaluates as true, the following methods will be available on the | |
536 | C<$result> object. | |
537 | ||
538 | =head3 C<comment> | |
539 | ||
540 | if ( $result->is_comment ) { | |
541 | my $comment = $result->comment; | |
542 | print "I have something to say: $comment"; | |
543 | } | |
544 | ||
545 | =head2 C<bailout> methods | |
546 | ||
547 | if ( $result->is_bailout ) { ... } | |
548 | ||
549 | If the above evaluates as true, the following methods will be available on the | |
550 | C<$result> object. | |
551 | ||
552 | =head3 C<explanation> | |
553 | ||
554 | if ( $result->is_bailout ) { | |
555 | my $explanation = $result->explanation; | |
556 | print "We bailed out because ($explanation)"; | |
557 | } | |
558 | ||
559 | If, and only if, a token is a bailout token, you can get an "explanation" via | |
560 | this method. The explanation is the text after the mystical "Bail out!" words | |
561 | which appear in the tap output. | |
562 | ||
563 | =head2 C<unknown> methods | |
564 | ||
565 | if ( $result->is_unknown ) { ... } | |
566 | ||
567 | There are no unique methods for unknown results. | |
568 | ||
569 | =head2 C<test> methods | |
570 | ||
571 | if ( $result->is_test ) { ... } | |
572 | ||
573 | If the above evaluates as true, the following methods will be available on the | |
574 | C<$result> object. | |
575 | ||
576 | =head3 C<ok> | |
577 | ||
578 | my $ok = $result->ok; | |
579 | ||
580 | Returns the literal text of the C<ok> or C<not ok> status. | |
581 | ||
582 | =head3 C<number> | |
583 | ||
584 | my $test_number = $result->number; | |
585 | ||
586 | Returns the number of the test, even if the original TAP output did not supply | |
587 | that number. | |
588 | ||
589 | =head3 C<description> | |
590 | ||
591 | my $description = $result->description; | |
592 | ||
593 | Returns the description of the test, if any. This is the portion after the | |
594 | test number but before the directive. | |
595 | ||
596 | =head3 C<directive> | |
597 | ||
598 | my $directive = $result->directive; | |
599 | ||
600 | Returns either C<TODO> or C<SKIP> if either directive was present for a test | |
601 | line. | |
602 | ||
603 | =head3 C<explanation> | |
604 | ||
605 | my $explanation = $result->explanation; | |
606 | ||
607 | If a test had either a C<TODO> or C<SKIP> directive, this method will return | |
608 | the accompanying explantion, if present. | |
609 | ||
610 | not ok 17 - 'Pigs can fly' # TODO not enough acid | |
611 | ||
612 | For the above line, the explanation is I<not enough acid>. | |
613 | ||
614 | =head3 C<is_ok> | |
615 | ||
616 | if ( $result->is_ok ) { ... } | |
617 | ||
618 | Returns a boolean value indicating whether or not the test passed. Remember | |
619 | that for TODO tests, the test always passes. | |
620 | ||
621 | B<Note:> this was formerly C<passed>. The latter method is deprecated and | |
622 | will issue a warning. | |
623 | ||
624 | =head3 C<is_actual_ok> | |
625 | ||
626 | if ( $result->is_actual_ok ) { ... } | |
627 | ||
628 | Returns a boolean value indicating whether or not the test passed, regardless | |
629 | of its TODO status. | |
630 | ||
631 | B<Note:> this was formerly C<actual_passed>. The latter method is deprecated | |
632 | and will issue a warning. | |
633 | ||
634 | =head3 C<is_unplanned> | |
635 | ||
636 | if ( $test->is_unplanned ) { ... } | |
637 | ||
638 | If a test number is greater than the number of planned tests, this method will | |
639 | return true. Unplanned tests will I<always> return false for C<is_ok>, | |
640 | regardless of whether or not the test C<has_todo> (see | |
641 | L<TAP::Parser::Result::Test> for more information about this). | |
642 | ||
643 | =head3 C<has_skip> | |
644 | ||
645 | if ( $result->has_skip ) { ... } | |
646 | ||
647 | Returns a boolean value indicating whether or not this test had a SKIP | |
648 | directive. | |
649 | ||
650 | =head3 C<has_todo> | |
651 | ||
652 | if ( $result->has_todo ) { ... } | |
653 | ||
654 | Returns a boolean value indicating whether or not this test had a TODO | |
655 | directive. | |
656 | ||
657 | Note that TODO tests I<always> pass. If you need to know whether or not | |
658 | they really passed, check the C<is_actual_ok> method. | |
659 | ||
660 | =head3 C<in_todo> | |
661 | ||
662 | if ( $parser->in_todo ) { ... } | |
663 | ||
664 | True while the most recent result was a TODO. Becomes true before the | |
665 | TODO result is returned and stays true until just before the next non- | |
666 | TODO test is returned. | |
667 | ||
668 | =head1 TOTAL RESULTS | |
669 | ||
670 | After parsing the TAP, there are many methods available to let you dig through | |
671 | the results and determine what is meaningful to you. | |
672 | ||
673 | =head2 Individual Results | |
674 | ||
675 | These results refer to individual tests which are run. | |
676 | ||
677 | =head3 C<passed> | |
678 | ||
679 | my @passed = $parser->passed; # the test numbers which passed | |
680 | my $passed = $parser->passed; # the number of tests which passed | |
681 | ||
682 | This method lets you know which (or how many) tests passed. If a test failed | |
683 | but had a TODO directive, it will be counted as a passed test. | |
684 | ||
685 | =cut | |
686 | ||
687 | sub passed { @{ shift->{passed} } } | |
688 | ||
689 | =head3 C<failed> | |
690 | ||
691 | my @failed = $parser->failed; # the test numbers which failed | |
692 | my $failed = $parser->failed; # the number of tests which failed | |
693 | ||
694 | This method lets you know which (or how many) tests failed. If a test passed | |
695 | but had a TODO directive, it will B<NOT> be counted as a failed test. | |
696 | ||
697 | =cut | |
698 | ||
699 | sub failed { @{ shift->{failed} } } | |
700 | ||
701 | =head3 C<actual_passed> | |
702 | ||
703 | # the test numbers which actually passed | |
704 | my @actual_passed = $parser->actual_passed; | |
705 | ||
706 | # the number of tests which actually passed | |
707 | my $actual_passed = $parser->actual_passed; | |
708 | ||
709 | This method lets you know which (or how many) tests actually passed, | |
710 | regardless of whether or not a TODO directive was found. | |
711 | ||
712 | =cut | |
713 | ||
714 | sub actual_passed { @{ shift->{actual_passed} } } | |
715 | *actual_ok = \&actual_passed; | |
716 | ||
717 | =head3 C<actual_ok> | |
718 | ||
719 | This method is a synonym for C<actual_passed>. | |
720 | ||
721 | =head3 C<actual_failed> | |
722 | ||
723 | # the test numbers which actually failed | |
724 | my @actual_failed = $parser->actual_failed; | |
725 | ||
726 | # the number of tests which actually failed | |
727 | my $actual_failed = $parser->actual_failed; | |
728 | ||
729 | This method lets you know which (or how many) tests actually failed, | |
730 | regardless of whether or not a TODO directive was found. | |
731 | ||
732 | =cut | |
733 | ||
734 | sub actual_failed { @{ shift->{actual_failed} } } | |
735 | ||
736 | ############################################################################## | |
737 | ||
738 | =head3 C<todo> | |
739 | ||
740 | my @todo = $parser->todo; # the test numbers with todo directives | |
741 | my $todo = $parser->todo; # the number of tests with todo directives | |
742 | ||
743 | This method lets you know which (or how many) tests had TODO directives. | |
744 | ||
745 | =cut | |
746 | ||
747 | sub todo { @{ shift->{todo} } } | |
748 | ||
749 | =head3 C<todo_passed> | |
750 | ||
751 | # the test numbers which unexpectedly succeeded | |
752 | my @todo_passed = $parser->todo_passed; | |
753 | ||
754 | # the number of tests which unexpectedly succeeded | |
755 | my $todo_passed = $parser->todo_passed; | |
756 | ||
757 | This method lets you know which (or how many) tests actually passed but were | |
758 | declared as "TODO" tests. | |
759 | ||
760 | =cut | |
761 | ||
762 | sub todo_passed { @{ shift->{todo_passed} } } | |
763 | ||
764 | ############################################################################## | |
765 | ||
766 | =head3 C<todo_failed> | |
767 | ||
768 | # deprecated in favor of 'todo_passed'. This method was horribly misnamed. | |
769 | ||
770 | This was a badly misnamed method. It indicates which TODO tests unexpectedly | |
771 | succeeded. Will now issue a warning and call C<todo_passed>. | |
772 | ||
773 | =cut | |
774 | ||
775 | sub todo_failed { | |
776 | warn | |
777 | '"todo_failed" is deprecated. Please use "todo_passed". See the docs.'; | |
778 | goto &todo_passed; | |
779 | } | |
780 | ||
781 | =head3 C<skipped> | |
782 | ||
783 | my @skipped = $parser->skipped; # the test numbers with SKIP directives | |
784 | my $skipped = $parser->skipped; # the number of tests with SKIP directives | |
785 | ||
786 | This method lets you know which (or how many) tests had SKIP directives. | |
787 | ||
788 | =cut | |
789 | ||
790 | sub skipped { @{ shift->{skipped} } } | |
791 | ||
792 | =head2 Summary Results | |
793 | ||
794 | These results are "meta" information about the total results of an individual | |
795 | test program. | |
796 | ||
797 | =head3 C<plan> | |
798 | ||
799 | my $plan = $parser->plan; | |
800 | ||
801 | Returns the test plan, if found. | |
802 | ||
803 | =head3 C<good_plan> | |
804 | ||
805 | Deprecated. Use C<is_good_plan> instead. | |
806 | ||
807 | =cut | |
808 | ||
809 | sub good_plan { | |
810 | warn 'good_plan() is deprecated. Please use "is_good_plan()"'; | |
811 | goto &is_good_plan; | |
812 | } | |
813 | ||
814 | ############################################################################## | |
815 | ||
816 | =head3 C<is_good_plan> | |
817 | ||
818 | if ( $parser->is_good_plan ) { ... } | |
819 | ||
820 | Returns a boolean value indicating whether or not the number of tests planned | |
821 | matches the number of tests run. | |
822 | ||
823 | B<Note:> this was formerly C<good_plan>. The latter method is deprecated and | |
824 | will issue a warning. | |
825 | ||
826 | And since we're on that subject ... | |
827 | ||
828 | =head3 C<tests_planned> | |
829 | ||
830 | print $parser->tests_planned; | |
831 | ||
832 | Returns the number of tests planned, according to the plan. For example, a | |
833 | plan of '1..17' will mean that 17 tests were planned. | |
834 | ||
835 | =head3 C<tests_run> | |
836 | ||
837 | print $parser->tests_run; | |
838 | ||
839 | Returns the number of tests which actually were run. Hopefully this will | |
840 | match the number of C<< $parser->tests_planned >>. | |
841 | ||
842 | =head3 C<skip_all> | |
843 | ||
844 | Returns a true value (actually the reason for skipping) if all tests | |
845 | were skipped. | |
846 | ||
847 | =head3 C<start_time> | |
848 | ||
849 | Returns the time when the Parser was created. | |
850 | ||
851 | =head3 C<end_time> | |
852 | ||
853 | Returns the time when the end of TAP input was seen. | |
854 | ||
855 | =head3 C<has_problems> | |
856 | ||
857 | if ( $parser->has_problems ) { | |
858 | ... | |
859 | } | |
860 | ||
861 | This is a 'catch-all' method which returns true if any tests have currently | |
862 | failed, any TODO tests unexpectedly succeeded, or any parse errors occurred. | |
863 | ||
864 | =cut | |
865 | ||
866 | sub has_problems { | |
867 | my $self = shift; | |
69f36734 AA |
868 | return |
869 | $self->failed | |
b965d173 NC |
870 | || $self->parse_errors |
871 | || $self->wait | |
872 | || $self->exit; | |
873 | } | |
874 | ||
875 | =head3 C<version> | |
876 | ||
877 | $parser->version; | |
878 | ||
879 | Once the parser is done, this will return the version number for the | |
880 | parsed TAP. Version numbers were introduced with TAP version 13 so if no | |
881 | version number is found version 12 is assumed. | |
882 | ||
883 | =head3 C<exit> | |
884 | ||
885 | $parser->exit; | |
886 | ||
887 | Once the parser is done, this will return the exit status. If the parser ran | |
888 | an executable, it returns the exit status of the executable. | |
889 | ||
890 | =head3 C<wait> | |
891 | ||
892 | $parser->wait; | |
893 | ||
894 | Once the parser is done, this will return the wait status. If the parser ran | |
895 | an executable, it returns the wait status of the executable. Otherwise, this | |
896 | mererely returns the C<exit> status. | |
897 | ||
898 | =head3 C<parse_errors> | |
899 | ||
900 | my @errors = $parser->parse_errors; # the parser errors | |
901 | my $errors = $parser->parse_errors; # the number of parser_errors | |
902 | ||
903 | Fortunately, all TAP output is perfect. In the event that it is not, this | |
904 | method will return parser errors. Note that a junk line which the parser does | |
905 | not recognize is C<not> an error. This allows this parser to handle future | |
906 | versions of TAP. The following are all TAP errors reported by the parser: | |
907 | ||
908 | =over 4 | |
909 | ||
910 | =item * Misplaced plan | |
911 | ||
912 | The plan (for example, '1..5'), must only come at the beginning or end of the | |
913 | TAP output. | |
914 | ||
915 | =item * No plan | |
916 | ||
917 | Gotta have a plan! | |
918 | ||
919 | =item * More than one plan | |
920 | ||
921 | 1..3 | |
922 | ok 1 - input file opened | |
923 | not ok 2 - first line of the input valid # todo some data | |
924 | ok 3 read the rest of the file | |
925 | 1..3 | |
926 | ||
927 | Right. Very funny. Don't do that. | |
928 | ||
929 | =item * Test numbers out of sequence | |
930 | ||
931 | 1..3 | |
932 | ok 1 - input file opened | |
933 | not ok 2 - first line of the input valid # todo some data | |
934 | ok 2 read the rest of the file | |
935 | ||
936 | That last test line above should have the number '3' instead of '2'. | |
937 | ||
938 | Note that it's perfectly acceptable for some lines to have test numbers and | |
939 | others to not have them. However, when a test number is found, it must be in | |
940 | sequence. The following is also an error: | |
941 | ||
942 | 1..3 | |
943 | ok 1 - input file opened | |
944 | not ok - first line of the input valid # todo some data | |
945 | ok 2 read the rest of the file | |
946 | ||
947 | But this is not: | |
948 | ||
949 | 1..3 | |
950 | ok - input file opened | |
951 | not ok - first line of the input valid # todo some data | |
952 | ok 3 read the rest of the file | |
953 | ||
954 | =back | |
955 | ||
956 | =cut | |
957 | ||
958 | sub parse_errors { @{ shift->{parse_errors} } } | |
959 | ||
960 | sub _add_error { | |
961 | my ( $self, $error ) = @_; | |
962 | push @{ $self->{parse_errors} } => $error; | |
963 | return $self; | |
964 | } | |
965 | ||
966 | sub _make_state_table { | |
967 | my $self = shift; | |
968 | my %states; | |
969 | my %planned_todo = (); | |
970 | ||
971 | #Â These transitions are defaults for all states | |
972 | my %state_globals = ( | |
973 | comment => {}, | |
974 | bailout => {}, | |
975 | version => { | |
976 | act => sub { | |
977 | my ($version) = @_; | |
978 | $self->_add_error( | |
979 | 'If TAP version is present it must be the first line of output' | |
980 | ); | |
981 | }, | |
982 | }, | |
983 | ); | |
984 | ||
985 | # Provides default elements for transitions | |
986 | my %state_defaults = ( | |
987 | plan => { | |
988 | act => sub { | |
989 | my ($plan) = @_; | |
990 | $self->tests_planned( $plan->tests_planned ); | |
991 | $self->plan( $plan->plan ); | |
992 | if ( $plan->has_skip ) { | |
993 | $self->skip_all( $plan->explanation | |
994 | || '(no reason given)' ); | |
995 | } | |
996 | ||
997 | $planned_todo{$_}++ for @{ $plan->todo_list }; | |
998 | }, | |
999 | }, | |
1000 | test => { | |
1001 | act => sub { | |
1002 | my ($test) = @_; | |
1003 | ||
1004 | my ( $number, $tests_run ) | |
1005 | = ( $test->number, ++$self->{tests_run} ); | |
1006 | ||
1007 | # Fake TODO state | |
1008 | if ( defined $number && delete $planned_todo{$number} ) { | |
1009 | $test->set_directive('TODO'); | |
1010 | } | |
1011 | ||
1012 | my $has_todo = $test->has_todo; | |
1013 | ||
1014 | $self->in_todo($has_todo); | |
1015 | if ( defined( my $tests_planned = $self->tests_planned ) ) { | |
1016 | if ( $tests_run > $tests_planned ) { | |
1017 | $test->is_unplanned(1); | |
1018 | } | |
1019 | } | |
1020 | ||
1021 | if ($number) { | |
1022 | if ( $number != $tests_run ) { | |
1023 | my $count = $tests_run; | |
1024 | $self->_add_error( "Tests out of sequence. Found " | |
1025 | . "($number) but expected ($count)" ); | |
1026 | } | |
1027 | } | |
1028 | else { | |
1029 | $test->_number( $number = $tests_run ); | |
1030 | } | |
1031 | ||
1032 | push @{ $self->{todo} } => $number if $has_todo; | |
1033 | push @{ $self->{todo_passed} } => $number | |
1034 | if $test->todo_passed; | |
1035 | push @{ $self->{skipped} } => $number | |
1036 | if $test->has_skip; | |
1037 | ||
1038 | push @{ $self->{ $test->is_ok ? 'passed' : 'failed' } } => | |
1039 | $number; | |
1040 | push @{ | |
1041 | $self->{ | |
1042 | $test->is_actual_ok | |
1043 | ? 'actual_passed' | |
1044 | : 'actual_failed' | |
1045 | } | |
1046 | } => $number; | |
1047 | }, | |
1048 | }, | |
1049 | yaml => { | |
1050 | act => sub { }, | |
1051 | }, | |
1052 | ); | |
1053 | ||
1054 | # Each state contains a hash the keys of which match a token type. For | |
1055 | # each token | |
1056 | # type there may be: | |
1057 | # act A coderef to run | |
1058 | # goto The new state to move to. Stay in this state if | |
1059 | # missing | |
1060 | # continue Goto the new state and run the new state for the | |
1061 | # current token | |
1062 | %states = ( | |
1063 | INIT => { | |
1064 | version => { | |
1065 | act => sub { | |
1066 | my ($version) = @_; | |
1067 | my $ver_num = $version->version; | |
1068 | if ( $ver_num <= $DEFAULT_TAP_VERSION ) { | |
1069 | my $ver_min = $DEFAULT_TAP_VERSION + 1; | |
1070 | $self->_add_error( | |
1071 | "Explicit TAP version must be at least " | |
1072 | . "$ver_min. Got version $ver_num" ); | |
1073 | $ver_num = $DEFAULT_TAP_VERSION; | |
1074 | } | |
1075 | if ( $ver_num > $MAX_TAP_VERSION ) { | |
1076 | $self->_add_error( | |
1077 | "TAP specified version $ver_num but " | |
1078 | . "we don't know about versions later " | |
1079 | . "than $MAX_TAP_VERSION" ); | |
1080 | $ver_num = $MAX_TAP_VERSION; | |
1081 | } | |
1082 | $self->version($ver_num); | |
1083 | $self->_grammar->set_version($ver_num); | |
1084 | }, | |
1085 | goto => 'PLAN' | |
1086 | }, | |
1087 | plan => { goto => 'PLANNED' }, | |
1088 | test => { goto => 'UNPLANNED' }, | |
1089 | }, | |
1090 | PLAN => { | |
1091 | plan => { goto => 'PLANNED' }, | |
1092 | test => { goto => 'UNPLANNED' }, | |
1093 | }, | |
1094 | PLANNED => { | |
1095 | test => { goto => 'PLANNED_AFTER_TEST' }, | |
1096 | plan => { | |
1097 | act => sub { | |
1098 | my ($version) = @_; | |
1099 | $self->_add_error( | |
1100 | 'More than one plan found in TAP output'); | |
1101 | }, | |
1102 | }, | |
1103 | }, | |
1104 | PLANNED_AFTER_TEST => { | |
1105 | test => { goto => 'PLANNED_AFTER_TEST' }, | |
1106 | plan => { act => sub { }, continue => 'PLANNED' }, | |
1107 | yaml => { goto => 'PLANNED' }, | |
1108 | }, | |
1109 | GOT_PLAN => { | |
1110 | test => { | |
1111 | act => sub { | |
1112 | my ($plan) = @_; | |
1113 | my $line = $self->plan; | |
1114 | $self->_add_error( | |
1115 | "Plan ($line) must be at the beginning " | |
1116 | . "or end of the TAP output" ); | |
1117 | $self->is_good_plan(0); | |
1118 | }, | |
1119 | continue => 'PLANNED' | |
1120 | }, | |
1121 | plan => { continue => 'PLANNED' }, | |
1122 | }, | |
1123 | UNPLANNED => { | |
1124 | test => { goto => 'UNPLANNED_AFTER_TEST' }, | |
1125 | plan => { goto => 'GOT_PLAN' }, | |
1126 | }, | |
1127 | UNPLANNED_AFTER_TEST => { | |
1128 | test => { act => sub { }, continue => 'UNPLANNED' }, | |
1129 | plan => { act => sub { }, continue => 'UNPLANNED' }, | |
1130 | yaml => { goto => 'PLANNED' }, | |
1131 | }, | |
1132 | ); | |
1133 | ||
1134 | # Apply globals and defaults to state table | |
1135 | for my $name ( sort keys %states ) { | |
1136 | ||
1137 | # Merge with globals | |
1138 | my $st = { %state_globals, %{ $states{$name} } }; | |
1139 | ||
1140 | # Add defaults | |
1141 | for my $next ( sort keys %{$st} ) { | |
1142 | if ( my $default = $state_defaults{$next} ) { | |
1143 | for my $def ( sort keys %{$default} ) { | |
1144 | $st->{$next}->{$def} ||= $default->{$def}; | |
1145 | } | |
1146 | } | |
1147 | } | |
1148 | ||
1149 | # Stuff back in table | |
1150 | $states{$name} = $st; | |
1151 | } | |
1152 | ||
1153 | return \%states; | |
1154 | } | |
1155 | ||
1156 | =head3 C<get_select_handles> | |
1157 | ||
1158 | Get an a list of file handles which can be passed to C<select> to | |
1159 | determine the readiness of this parser. | |
1160 | ||
1161 | =cut | |
1162 | ||
1163 | sub get_select_handles { shift->_stream->get_select_handles } | |
1164 | ||
1165 | sub _iter { | |
1166 | my $self = shift; | |
1167 | my $stream = $self->_stream; | |
1168 | my $spool = $self->_spool; | |
1169 | my $grammar = $self->_grammar; | |
1170 | my $state = 'INIT'; | |
1171 | my $state_table = $self->_make_state_table; | |
1172 | ||
1173 | # Make next_state closure | |
1174 | my $next_state = sub { | |
1175 | my $token = shift; | |
1176 | my $type = $token->type; | |
1177 | my $count = 1; | |
1178 | TRANS: { | |
1179 | my $state_spec = $state_table->{$state} | |
1180 | or die "Illegal state: $state"; | |
1181 | ||
1182 | if ( my $next = $state_spec->{$type} ) { | |
1183 | if ( my $act = $next->{act} ) { | |
1184 | $act->($token); | |
1185 | } | |
1186 | if ( my $cont = $next->{continue} ) { | |
1187 | $state = $cont; | |
1188 | redo TRANS; | |
1189 | } | |
1190 | elsif ( my $goto = $next->{goto} ) { | |
1191 | $state = $goto; | |
1192 | } | |
1193 | } | |
1194 | } | |
1195 | return $token; | |
1196 | }; | |
1197 | ||
1198 | # Handle end of stream - which means either pop a block or finish | |
1199 | my $end_handler = sub { | |
1200 | $self->exit( $stream->exit ); | |
1201 | $self->wait( $stream->wait ); | |
1202 | $self->_finish; | |
1203 | return; | |
1204 | }; | |
1205 | ||
1206 | # Finally make the closure that we return. For performance reasons | |
1207 | # there are two versions of the returned function: one that handles | |
1208 | # callbacks and one that does not. | |
1209 | if ( $self->_has_callbacks ) { | |
1210 | return sub { | |
1211 | my $result = eval { $grammar->tokenize }; | |
1212 | $self->_add_error($@) if $@; | |
1213 | ||
1214 | if ( defined $result ) { | |
1215 | $result = $next_state->($result); | |
1216 | ||
1217 | if ( my $code = $self->_callback_for( $result->type ) ) { | |
1218 | $_->($result) for @{$code}; | |
1219 | } | |
1220 | else { | |
1221 | $self->_make_callback( 'ELSE', $result ); | |
1222 | } | |
1223 | ||
1224 | $self->_make_callback( 'ALL', $result ); | |
1225 | ||
1226 | # Echo TAP to spool file | |
1227 | print {$spool} $result->raw, "\n" if $spool; | |
1228 | } | |
1229 | else { | |
1230 | $result = $end_handler->(); | |
1231 | $self->_make_callback( 'EOF', $result ) | |
1232 | unless defined $result; | |
1233 | } | |
1234 | ||
1235 | return $result; | |
1236 | }; | |
1237 | } # _has_callbacks | |
1238 | else { | |
1239 | return sub { | |
1240 | my $result = eval { $grammar->tokenize }; | |
1241 | $self->_add_error($@) if $@; | |
1242 | ||
1243 | if ( defined $result ) { | |
1244 | $result = $next_state->($result); | |
1245 | ||
1246 | # Echo TAP to spool file | |
1247 | print {$spool} $result->raw, "\n" if $spool; | |
1248 | } | |
1249 | else { | |
1250 | $result = $end_handler->(); | |
1251 | } | |
1252 | ||
1253 | return $result; | |
1254 | }; | |
1255 | } # no callbacks | |
1256 | } | |
1257 | ||
1258 | sub _finish { | |
1259 | my $self = shift; | |
1260 | ||
1261 | $self->end_time( $self->get_time ); | |
1262 | ||
1263 | # sanity checks | |
1264 | if ( !$self->plan ) { | |
1265 | $self->_add_error('No plan found in TAP output'); | |
1266 | } | |
1267 | else { | |
1268 | $self->is_good_plan(1) unless defined $self->is_good_plan; | |
1269 | } | |
1270 | if ( $self->tests_run != ( $self->tests_planned || 0 ) ) { | |
1271 | $self->is_good_plan(0); | |
1272 | if ( defined( my $planned = $self->tests_planned ) ) { | |
1273 | my $ran = $self->tests_run; | |
1274 | $self->_add_error( | |
1275 | "Bad plan. You planned $planned tests but ran $ran."); | |
1276 | } | |
1277 | } | |
1278 | if ( $self->tests_run != ( $self->passed + $self->failed ) ) { | |
1279 | ||
1280 | # this should never happen | |
1281 | my $actual = $self->tests_run; | |
1282 | my $passed = $self->passed; | |
1283 | my $failed = $self->failed; | |
1284 | $self->_croak( "Panic: planned test count ($actual) did not equal " | |
1285 | . "sum of passed ($passed) and failed ($failed) tests!" ); | |
1286 | } | |
1287 | ||
1288 | $self->is_good_plan(0) unless defined $self->is_good_plan; | |
1289 | return $self; | |
1290 | } | |
1291 | ||
1292 | =head3 C<delete_spool> | |
1293 | ||
1294 | Delete and return the spool. | |
1295 | ||
1296 | my $fh = $parser->delete_spool; | |
1297 | ||
1298 | =cut | |
1299 | ||
1300 | sub delete_spool { | |
1301 | my $self = shift; | |
1302 | ||
1303 | return delete $self->{_spool}; | |
1304 | } | |
1305 | ||
1306 | ############################################################################## | |
1307 | ||
1308 | =head1 CALLBACKS | |
1309 | ||
1310 | As mentioned earlier, a "callback" key may be added to the | |
1311 | C<TAP::Parser> constructor. If present, each callback corresponding to a | |
1312 | given result type will be called with the result as the argument if the | |
1313 | C<run> method is used. The callback is expected to be a subroutine | |
1314 | reference (or anonymous subroutine) which is invoked with the parser | |
1315 | result as its argument. | |
1316 | ||
1317 | my %callbacks = ( | |
1318 | test => \&test_callback, | |
1319 | plan => \&plan_callback, | |
1320 | comment => \&comment_callback, | |
1321 | bailout => \&bailout_callback, | |
1322 | unknown => \&unknown_callback, | |
1323 | ); | |
1324 | ||
1325 | my $aggregator = TAP::Parser::Aggregator->new; | |
1326 | foreach my $file ( @test_files ) { | |
1327 | my $parser = TAP::Parser->new( | |
1328 | { | |
1329 | source => $file, | |
1330 | callbacks => \%callbacks, | |
1331 | } | |
1332 | ); | |
1333 | $parser->run; | |
1334 | $aggregator->add( $file, $parser ); | |
1335 | } | |
1336 | ||
1337 | Callbacks may also be added like this: | |
1338 | ||
1339 | $parser->callback( test => \&test_callback ); | |
1340 | $parser->callback( plan => \&plan_callback ); | |
1341 | ||
1342 | The following keys allowed for callbacks. These keys are case-sensitive. | |
1343 | ||
1344 | =over 4 | |
1345 | ||
1346 | =item * C<test> | |
1347 | ||
1348 | Invoked if C<< $result->is_test >> returns true. | |
1349 | ||
1350 | =item * C<version> | |
1351 | ||
1352 | Invoked if C<< $result->is_version >> returns true. | |
1353 | ||
1354 | =item * C<plan> | |
1355 | ||
1356 | Invoked if C<< $result->is_plan >> returns true. | |
1357 | ||
1358 | =item * C<comment> | |
1359 | ||
1360 | Invoked if C<< $result->is_comment >> returns true. | |
1361 | ||
1362 | =item * C<bailout> | |
1363 | ||
1364 | Invoked if C<< $result->is_unknown >> returns true. | |
1365 | ||
1366 | =item * C<yaml> | |
1367 | ||
1368 | Invoked if C<< $result->is_yaml >> returns true. | |
1369 | ||
1370 | =item * C<unknown> | |
1371 | ||
1372 | Invoked if C<< $result->is_unknown >> returns true. | |
1373 | ||
1374 | =item * C<ELSE> | |
1375 | ||
1376 | If a result does not have a callback defined for it, this callback will | |
1377 | be invoked. Thus, if all of the previous result types are specified as | |
1378 | callbacks, this callback will I<never> be invoked. | |
1379 | ||
1380 | =item * C<ALL> | |
1381 | ||
1382 | This callback will always be invoked and this will happen for each | |
1383 | result after one of the above callbacks is invoked. For example, if | |
1384 | L<Term::ANSIColor> is loaded, you could use the following to color your | |
1385 | test output: | |
1386 | ||
1387 | my %callbacks = ( | |
1388 | test => sub { | |
1389 | my $test = shift; | |
1390 | if ( $test->is_ok && not $test->directive ) { | |
1391 | # normal passing test | |
1392 | print color 'green'; | |
1393 | } | |
1394 | elsif ( !$test->is_ok ) { # even if it's TODO | |
1395 | print color 'white on_red'; | |
1396 | } | |
1397 | elsif ( $test->has_skip ) { | |
1398 | print color 'white on_blue'; | |
1399 | ||
1400 | } | |
1401 | elsif ( $test->has_todo ) { | |
1402 | print color 'white'; | |
1403 | } | |
1404 | }, | |
1405 | ELSE => sub { | |
1406 | # plan, comment, and so on (anything which isn't a test line) | |
1407 | print color 'black on_white'; | |
1408 | }, | |
1409 | ALL => sub { | |
1410 | # now print them | |
1411 | print shift->as_string; | |
1412 | print color 'reset'; | |
1413 | print "\n"; | |
1414 | }, | |
1415 | ); | |
1416 | ||
1417 | =item * C<EOF> | |
1418 | ||
1419 | Invoked when there are no more lines to be parsed. Since there is no | |
1420 | accompanying L<TAP::Parser::Result> object the C<TAP::Parser> object is | |
1421 | passed instead. | |
1422 | ||
1423 | =back | |
1424 | ||
1425 | =head1 TAP GRAMMAR | |
1426 | ||
1427 | If you're looking for an EBNF grammar, see L<TAP::Parser::Grammar>. | |
1428 | ||
1429 | =head1 BACKWARDS COMPATABILITY | |
1430 | ||
1431 | The Perl-QA list attempted to ensure backwards compatability with | |
1432 | L<Test::Harness>. However, there are some minor differences. | |
1433 | ||
1434 | =head2 Differences | |
1435 | ||
1436 | =over 4 | |
1437 | ||
1438 | =item * TODO plans | |
1439 | ||
1440 | A little-known feature of L<Test::Harness> is that it supported TODO | |
1441 | lists in the plan: | |
1442 | ||
1443 | 1..2 todo 2 | |
1444 | ok 1 - We have liftoff | |
1445 | not ok 2 - Anti-gravity device activated | |
1446 | ||
1447 | Under L<Test::Harness>, test number 2 would I<pass> because it was | |
1448 | listed as a TODO test on the plan line. However, we are not aware of | |
1449 | anyone actually using this feature and hard-coding test numbers is | |
1450 | discouraged because it's very easy to add a test and break the test | |
1451 | number sequence. This makes test suites very fragile. Instead, the | |
1452 | following should be used: | |
1453 | ||
1454 | 1..2 | |
1455 | ok 1 - We have liftoff | |
1456 | not ok 2 - Anti-gravity device activated # TODO | |
1457 | ||
1458 | =item * 'Missing' tests | |
1459 | ||
1460 | It rarely happens, but sometimes a harness might encounter | |
1461 | 'missing tests: | |
1462 | ||
1463 | ok 1 | |
1464 | ok 2 | |
1465 | ok 15 | |
1466 | ok 16 | |
1467 | ok 17 | |
1468 | ||
1469 | L<Test::Harness> would report tests 3-14 as having failed. For the | |
1470 | C<TAP::Parser>, these tests are not considered failed because they've | |
1471 | never run. They're reported as parse failures (tests out of sequence). | |
1472 | ||
1473 | =back | |
1474 | ||
1475 | =head1 ACKNOWLEDGEMENTS | |
1476 | ||
1477 | All of the following have helped. Bug reports, patches, (im)moral | |
1478 | support, or just words of encouragement have all been forthcoming. | |
1479 | ||
1480 | =over 4 | |
1481 | ||
1482 | =item * Michael Schwern | |
1483 | ||
1484 | =item * Andy Lester | |
1485 | ||
1486 | =item * chromatic | |
1487 | ||
1488 | =item * GEOFFR | |
1489 | ||
1490 | =item * Shlomi Fish | |
1491 | ||
1492 | =item * Torsten Schoenfeld | |
1493 | ||
1494 | =item * Jerry Gay | |
1495 | ||
1496 | =item * Aristotle | |
1497 | ||
1498 | =item * Adam Kennedy | |
1499 | ||
1500 | =item * Yves Orton | |
1501 | ||
1502 | =item * Adrian Howard | |
1503 | ||
1504 | =item * Sean & Lil | |
1505 | ||
1506 | =item * Andreas J. Koenig | |
1507 | ||
1508 | =item * Florian Ragwitz | |
1509 | ||
1510 | =item * Corion | |
1511 | ||
1512 | =item * Mark Stosberg | |
1513 | ||
1514 | =item * Matt Kraai | |
1515 | ||
1516 | =back | |
1517 | ||
1518 | =head1 AUTHORS | |
1519 | ||
1520 | Curtis "Ovid" Poe <ovid@cpan.org> | |
1521 | ||
1522 | Andy Armstong <andy@hexten.net> | |
1523 | ||
1524 | Eric Wilhelm @ <ewilhelm at cpan dot org> | |
1525 | ||
1526 | Michael Peters <mpeters at plusthree dot com> | |
1527 | ||
1528 | Leif Eriksen <leif dot eriksen at bigpond dot com> | |
1529 | ||
1530 | =head1 BUGS | |
1531 | ||
1532 | Please report any bugs or feature requests to | |
1533 | C<bug-tapx-parser@rt.cpan.org>, or through the web interface at | |
1534 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=TAP-Parser>. | |
1535 | We will be notified, and then you'll automatically be notified of | |
1536 | progress on your bug as we make changes. | |
1537 | ||
1538 | Obviously, bugs which include patches are best. If you prefer, you can | |
1539 | patch against bleed by via anonymous checkout of the latest version: | |
1540 | ||
1541 | svn checkout http://svn.hexten.net/tapx | |
1542 | ||
1543 | =head1 COPYRIGHT & LICENSE | |
1544 | ||
1545 | Copyright 2006-2007 Curtis "Ovid" Poe, all rights reserved. | |
1546 | ||
1547 | This program is free software; you can redistribute it and/or modify it | |
1548 | under the same terms as Perl itself. | |
1549 | ||
1550 | =cut | |
1551 | ||
1552 | 1; |