local-lib5/lib/perl5/TAP/Parser.pm

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