1package TAP::Harness;
2
3use strict;
4use warnings;
5use Carp;
6
7use File::Spec;
8use File::Path;
9use IO::Handle;
10
11use base 'TAP::Base';
12
13=head1 NAME
14
15TAP::Harness - Run test scripts with statistics
16
17=head1 VERSION
18
19Version 3.30
20
21=cut
22
23our $VERSION = '3.30';
24
25$ENV{HARNESS_ACTIVE}  = 1;
26$ENV{HARNESS_VERSION} = $VERSION;
27
28END {
29
30    # For VMS.
31    delete $ENV{HARNESS_ACTIVE};
32    delete $ENV{HARNESS_VERSION};
33}
34
35=head1 DESCRIPTION
36
37This is a simple test harness which allows tests to be run and results
38automatically aggregated and output to STDOUT.
39
40=head1 SYNOPSIS
41
42 use TAP::Harness;
43 my $harness = TAP::Harness->new( \%args );
44 $harness->runtests(@tests);
45
46=cut
47
48my %VALIDATION_FOR;
49my @FORMATTER_ARGS;
50
51sub _error {
52    my $self = shift;
53    return $self->{error} unless @_;
54    $self->{error} = shift;
55}
56
57BEGIN {
58
59    @FORMATTER_ARGS = qw(
60      directives verbosity timer failures comments errors stdout color
61      show_count normalize
62    );
63
64    %VALIDATION_FOR = (
65        lib => sub {
66            my ( $self, $libs ) = @_;
67            $libs = [$libs] unless 'ARRAY' eq ref $libs;
68
69            return [ map {"-I$_"} @$libs ];
70        },
71        switches          => sub { shift; shift },
72        exec              => sub { shift; shift },
73        merge             => sub { shift; shift },
74        aggregator_class  => sub { shift; shift },
75        formatter_class   => sub { shift; shift },
76        multiplexer_class => sub { shift; shift },
77        parser_class      => sub { shift; shift },
78        scheduler_class   => sub { shift; shift },
79        formatter         => sub { shift; shift },
80        jobs              => sub { shift; shift },
81        test_args         => sub { shift; shift },
82        ignore_exit       => sub { shift; shift },
83        rules             => sub { shift; shift },
84        sources           => sub { shift; shift },
85        version           => sub { shift; shift },
86        trap              => sub { shift; shift },
87    );
88
89    for my $method ( sort keys %VALIDATION_FOR ) {
90        no strict 'refs';
91        if ( $method eq 'lib' || $method eq 'switches' ) {
92            *{$method} = sub {
93                my $self = shift;
94                unless (@_) {
95                    $self->{$method} ||= [];
96                    return wantarray
97                      ? @{ $self->{$method} }
98                      : $self->{$method};
99                }
100                $self->_croak("Too many arguments to method '$method'")
101                  if @_ > 1;
102                my $args = shift;
103                $args = [$args] unless ref $args;
104                $self->{$method} = $args;
105                return $self;
106            };
107        }
108        else {
109            *{$method} = sub {
110                my $self = shift;
111                return $self->{$method} unless @_;
112                $self->{$method} = shift;
113            };
114        }
115    }
116
117    for my $method (@FORMATTER_ARGS) {
118        no strict 'refs';
119        *{$method} = sub {
120            my $self = shift;
121            return $self->formatter->$method(@_);
122        };
123    }
124}
125
126##############################################################################
127
128=head1 METHODS
129
130=head2 Class Methods
131
132=head3 C<new>
133
134 my %args = (
135    verbosity => 1,
136    lib     => [ 'lib', 'blib/lib', 'blib/arch' ],
137 )
138 my $harness = TAP::Harness->new( \%args );
139
140The constructor returns a new C<TAP::Harness> object. It accepts an
141optional hashref whose allowed keys are:
142
143=over 4
144
145=item * C<verbosity>
146
147Set the verbosity level:
148
149     1   verbose        Print individual test results to STDOUT.
150     0   normal
151    -1   quiet          Suppress some test output (mostly failures
152                        while tests are running).
153    -2   really quiet   Suppress everything but the tests summary.
154    -3   silent         Suppress everything.
155
156=item * C<timer>
157
158Append run time for each test to output. Uses L<Time::HiRes> if
159available.
160
161=item * C<failures>
162
163Show test failures (this is a no-op if C<verbose> is selected).
164
165=item * C<comments>
166
167Show test comments (this is a no-op if C<verbose> is selected).
168
169=item * C<show_count>
170
171Update the running test count during testing.
172
173=item * C<normalize>
174
175Set to a true value to normalize the TAP that is emitted in verbose modes.
176
177=item * C<lib>
178
179Accepts a scalar value or array ref of scalar values indicating which
180paths to allowed libraries should be included if Perl tests are
181executed. Naturally, this only makes sense in the context of tests
182written in Perl.
183
184=item * C<switches>
185
186Accepts a scalar value or array ref of scalar values indicating which
187switches should be included if Perl tests are executed. Naturally, this
188only makes sense in the context of tests written in Perl.
189
190=item * C<test_args>
191
192A reference to an C<@INC> style array of arguments to be passed to each
193test program.
194
195  test_args => ['foo', 'bar'],
196
197if you want to pass different arguments to each test then you should
198pass a hash of arrays, keyed by the alias for each test:
199
200  test_args => {
201    my_test    => ['foo', 'bar'],
202    other_test => ['baz'],
203  }
204
205=item * C<color>
206
207Attempt to produce color output.
208
209=item * C<exec>
210
211Typically, Perl tests are run through this. However, anything which
212spits out TAP is fine. You can use this argument to specify the name of
213the program (and optional switches) to run your tests with:
214
215  exec => ['/usr/bin/ruby', '-w']
216
217You can also pass a subroutine reference in order to determine and
218return the proper program to run based on a given test script. The
219subroutine reference should expect the TAP::Harness object itself as the
220first argument, and the file name as the second argument. It should
221return an array reference containing the command to be run and including
222the test file name. It can also simply return C<undef>, in which case
223TAP::Harness will fall back on executing the test script in Perl:
224
225    exec => sub {
226        my ( $harness, $test_file ) = @_;
227
228        # Let Perl tests run.
229        return undef if $test_file =~ /[.]t$/;
230        return [ qw( /usr/bin/ruby -w ), $test_file ]
231          if $test_file =~ /[.]rb$/;
232      }
233
234If the subroutine returns a scalar with a newline or a filehandle, it
235will be interpreted as raw TAP or as a TAP stream, respectively.
236
237=item * C<merge>
238
239If C<merge> is true the harness will create parsers that merge STDOUT
240and STDERR together for any processes they start.
241
242=item * C<sources>
243
244I<NEW to 3.18>.
245
246If set, C<sources> must be a hashref containing the names of the
247L<TAP::Parser::SourceHandler>s to load and/or configure.  The values are a
248hash of configuration that will be accessible to the source handlers via
249L<TAP::Parser::Source/config_for>.
250
251For example:
252
253  sources => {
254    Perl => { exec => '/path/to/custom/perl' },
255    File => { extensions => [ '.tap', '.txt' ] },
256    MyCustom => { some => 'config' },
257  }
258
259The C<sources> parameter affects how C<source>, C<tap> and C<exec> parameters
260are handled.
261
262For more details, see the C<sources> parameter in L<TAP::Parser/new>,
263L<TAP::Parser::Source>, and L<TAP::Parser::IteratorFactory>.
264
265=item * C<aggregator_class>
266
267The name of the class to use to aggregate test results. The default is
268L<TAP::Parser::Aggregator>.
269
270=item * C<version>
271
272I<NEW to 3.22>.
273
274Assume this TAP version for L<TAP::Parser> instead of default TAP
275version 12.
276
277=item * C<formatter_class>
278
279The name of the class to use to format output. The default is
280L<TAP::Formatter::Console>, or L<TAP::Formatter::File> if the output
281isn't a TTY.
282
283=item * C<multiplexer_class>
284
285The name of the class to use to multiplex tests during parallel testing.
286The default is L<TAP::Parser::Multiplexer>.
287
288=item * C<parser_class>
289
290The name of the class to use to parse TAP. The default is
291L<TAP::Parser>.
292
293=item * C<scheduler_class>
294
295The name of the class to use to schedule test execution. The default is
296L<TAP::Parser::Scheduler>.
297
298=item * C<formatter>
299
300If set C<formatter> must be an object that is capable of formatting the
301TAP output. See L<TAP::Formatter::Console> for an example.
302
303=item * C<errors>
304
305If parse errors are found in the TAP output, a note of this will be
306made in the summary report. To see all of the parse errors, set this
307argument to true:
308
309  errors => 1
310
311=item * C<directives>
312
313If set to a true value, only test results with directives will be
314displayed. This overrides other settings such as C<verbose> or
315C<failures>.
316
317=item * C<ignore_exit>
318
319If set to a true value instruct C<TAP::Parser> to ignore exit and wait
320status from test scripts.
321
322=item * C<jobs>
323
324The maximum number of parallel tests to run at any time.  Which tests
325can be run in parallel is controlled by C<rules>.  The default is to
326run only one test at a time.
327
328=item * C<rules>
329
330A reference to a hash of rules that control which tests may be executed in
331parallel. If no rules are declared, all tests are eligible for being run in
332parallel. Here some simple examples. For the full details of the data structure
333and the related glob-style pattern matching, see
334L<TAP::Parser::Scheduler/"Rules data structure">.
335
336    # Run all tests in sequence, except those starting with "p"
337    $harness->rules({
338        par => 't/p*.t'
339    });
340
341    # Run all tests in parallel, except those starting with "p"
342    $harness->rules({
343        seq => [
344                  { seq => 't/p*.t' },
345                  { par => '**'     },
346               ],
347    });
348
349    # Run some  startup tests in sequence, then some parallel tests than some
350    # teardown tests in sequence.
351    $harness->rules({
352        seq => [
353            { seq => 't/startup/*.t' },
354            { par => ['t/a/*.t','t/b/*.t','t/c/*.t'], }
355            { seq => 't/shutdown/*.t' },
356        ],
357
358    });
359
360This is an experimental feature and the interface may change.
361
362=item * C<stdout>
363
364A filehandle for catching standard output.
365
366=item * C<trap>
367
368Attempt to print summary information if run is interrupted by
369SIGINT (Ctrl-C).
370
371=back
372
373Any keys for which the value is C<undef> will be ignored.
374
375=cut
376
377# new supplied by TAP::Base
378
379{
380    my @legal_callback = qw(
381      parser_args
382      made_parser
383      before_runtests
384      after_runtests
385      after_test
386    );
387
388    my %default_class = (
389        aggregator_class  => 'TAP::Parser::Aggregator',
390        formatter_class   => 'TAP::Formatter::Console',
391        multiplexer_class => 'TAP::Parser::Multiplexer',
392        parser_class      => 'TAP::Parser',
393        scheduler_class   => 'TAP::Parser::Scheduler',
394    );
395
396    sub _initialize {
397        my ( $self, $arg_for ) = @_;
398        $arg_for ||= {};
399
400        $self->SUPER::_initialize( $arg_for, \@legal_callback );
401        my %arg_for = %$arg_for;    # force a shallow copy
402
403        for my $name ( sort keys %VALIDATION_FOR ) {
404            my $property = delete $arg_for{$name};
405            if ( defined $property ) {
406                my $validate = $VALIDATION_FOR{$name};
407
408                my $value = $self->$validate($property);
409                if ( $self->_error ) {
410                    $self->_croak;
411                }
412                $self->$name($value);
413            }
414        }
415
416        $self->jobs(1) unless defined $self->jobs;
417
418        local $default_class{formatter_class} = 'TAP::Formatter::File'
419          unless -t ( $arg_for{stdout} || \*STDOUT ) && !$ENV{HARNESS_NOTTY};
420
421        while ( my ( $attr, $class ) = each %default_class ) {
422            $self->$attr( $self->$attr() || $class );
423        }
424
425        unless ( $self->formatter ) {
426
427            # This is a little bodge to preserve legacy behaviour. It's
428            # pretty horrible that we know which args are destined for
429            # the formatter.
430            my %formatter_args = ( jobs => $self->jobs );
431            for my $name (@FORMATTER_ARGS) {
432                if ( defined( my $property = delete $arg_for{$name} ) ) {
433                    $formatter_args{$name} = $property;
434                }
435            }
436
437            $self->formatter(
438                $self->_construct( $self->formatter_class, \%formatter_args )
439            );
440        }
441
442        if ( my @props = sort keys %arg_for ) {
443            $self->_croak("Unknown arguments to TAP::Harness::new (@props)");
444        }
445
446        return $self;
447    }
448}
449
450##############################################################################
451
452=head2 Instance Methods
453
454=head3 C<runtests>
455
456    $harness->runtests(@tests);
457
458Accepts an array of C<@tests> to be run. This should generally be the
459names of test files, but this is not required. Each element in C<@tests>
460will be passed to C<TAP::Parser::new()> as a C<source>. See
461L<TAP::Parser> for more information.
462
463It is possible to provide aliases that will be displayed in place of the
464test name by supplying the test as a reference to an array containing
465C<< [ $test, $alias ] >>:
466
467    $harness->runtests( [ 't/foo.t', 'Foo Once' ],
468                        [ 't/foo.t', 'Foo Twice' ] );
469
470Normally it is an error to attempt to run the same test twice. Aliases
471allow you to overcome this limitation by giving each run of the test a
472unique name.
473
474Tests will be run in the order found.
475
476If the environment variable C<PERL_TEST_HARNESS_DUMP_TAP> is defined it
477should name a directory into which a copy of the raw TAP for each test
478will be written. TAP is written to files named for each test.
479Subdirectories will be created as needed.
480
481Returns a L<TAP::Parser::Aggregator> containing the test results.
482
483=cut
484
485sub runtests {
486    my ( $self, @tests ) = @_;
487
488    my $aggregate = $self->_construct( $self->aggregator_class );
489
490    $self->_make_callback( 'before_runtests', $aggregate );
491    $aggregate->start;
492    my $finish = sub {
493        my $interrupted = shift;
494        $aggregate->stop;
495        $self->summary( $aggregate, $interrupted );
496        $self->_make_callback( 'after_runtests', $aggregate );
497    };
498    my $run = sub {
499        $self->aggregate_tests( $aggregate, @tests );
500        $finish->();
501    };
502
503    if ( $self->trap ) {
504        local $SIG{INT} = sub {
505            print "\n";
506            $finish->(1);
507            exit;
508        };
509        $run->();
510    }
511    else {
512        $run->();
513    }
514
515    return $aggregate;
516}
517
518=head3 C<summary>
519
520  $harness->summary( $aggregator );
521
522Output the summary for a L<TAP::Parser::Aggregator>.
523
524=cut
525
526sub summary {
527    my ( $self, @args ) = @_;
528    $self->formatter->summary(@args);
529}
530
531sub _after_test {
532    my ( $self, $aggregate, $job, $parser ) = @_;
533
534    $self->_make_callback( 'after_test', $job->as_array_ref, $parser );
535    $aggregate->add( $job->description, $parser );
536}
537
538sub _bailout {
539    my ( $self, $result ) = @_;
540    my $explanation = $result->explanation;
541    die "FAILED--Further testing stopped"
542      . ( $explanation ? ": $explanation\n" : ".\n" );
543}
544
545sub _aggregate_parallel {
546    my ( $self, $aggregate, $scheduler ) = @_;
547
548    my $jobs = $self->jobs;
549    my $mux  = $self->_construct( $self->multiplexer_class );
550
551    RESULT: {
552
553        # Keep multiplexer topped up
554        FILL:
555        while ( $mux->parsers < $jobs ) {
556            my $job = $scheduler->get_job;
557
558            # If we hit a spinner stop filling and start running.
559            last FILL if !defined $job || $job->is_spinner;
560
561            my ( $parser, $session ) = $self->make_parser($job);
562            $mux->add( $parser, [ $session, $job ] );
563        }
564
565        if ( my ( $parser, $stash, $result ) = $mux->next ) {
566            my ( $session, $job ) = @$stash;
567            if ( defined $result ) {
568                $session->result($result);
569                $self->_bailout($result) if $result->is_bailout;
570            }
571            else {
572
573                # End of parser. Automatically removed from the mux.
574                $self->finish_parser( $parser, $session );
575                $self->_after_test( $aggregate, $job, $parser );
576                $job->finish;
577            }
578            redo RESULT;
579        }
580    }
581
582    return;
583}
584
585sub _aggregate_single {
586    my ( $self, $aggregate, $scheduler ) = @_;
587
588    JOB:
589    while ( my $job = $scheduler->get_job ) {
590        next JOB if $job->is_spinner;
591
592        my ( $parser, $session ) = $self->make_parser($job);
593
594        while ( defined( my $result = $parser->next ) ) {
595            $session->result($result);
596            if ( $result->is_bailout ) {
597
598                # Keep reading until input is exhausted in the hope
599                # of allowing any pending diagnostics to show up.
600                1 while $parser->next;
601                $self->_bailout($result);
602            }
603        }
604
605        $self->finish_parser( $parser, $session );
606        $self->_after_test( $aggregate, $job, $parser );
607        $job->finish;
608    }
609
610    return;
611}
612
613=head3 C<aggregate_tests>
614
615  $harness->aggregate_tests( $aggregate, @tests );
616
617Run the named tests and display a summary of result. Tests will be run
618in the order found.
619
620Test results will be added to the supplied L<TAP::Parser::Aggregator>.
621C<aggregate_tests> may be called multiple times to run several sets of
622tests. Multiple C<Test::Harness> instances may be used to pass results
623to a single aggregator so that different parts of a complex test suite
624may be run using different C<TAP::Harness> settings. This is useful, for
625example, in the case where some tests should run in parallel but others
626are unsuitable for parallel execution.
627
628    my $formatter   = TAP::Formatter::Console->new;
629    my $ser_harness = TAP::Harness->new( { formatter => $formatter } );
630    my $par_harness = TAP::Harness->new(
631        {   formatter => $formatter,
632            jobs      => 9
633        }
634    );
635    my $aggregator = TAP::Parser::Aggregator->new;
636
637    $aggregator->start();
638    $ser_harness->aggregate_tests( $aggregator, @ser_tests );
639    $par_harness->aggregate_tests( $aggregator, @par_tests );
640    $aggregator->stop();
641    $formatter->summary($aggregator);
642
643Note that for simpler testing requirements it will often be possible to
644replace the above code with a single call to C<runtests>.
645
646Each element of the C<@tests> array is either:
647
648=over
649
650=item * the source name of a test to run
651
652=item * a reference to a [ source name, display name ] array
653
654=back
655
656In the case of a perl test suite, typically I<source names> are simply the file
657names of the test scripts to run.
658
659When you supply a separate display name it becomes possible to run a
660test more than once; the display name is effectively the alias by which
661the test is known inside the harness. The harness doesn't care if it
662runs the same test more than once when each invocation uses a
663different name.
664
665=cut
666
667sub aggregate_tests {
668    my ( $self, $aggregate, @tests ) = @_;
669
670    my $jobs      = $self->jobs;
671    my $scheduler = $self->make_scheduler(@tests);
672
673    # #12458
674    local $ENV{HARNESS_IS_VERBOSE} = 1
675      if $self->formatter->verbosity > 0;
676
677    # Formatter gets only names.
678    $self->formatter->prepare( map { $_->description } $scheduler->get_all );
679
680    if ( $self->jobs > 1 ) {
681        $self->_aggregate_parallel( $aggregate, $scheduler );
682    }
683    else {
684        $self->_aggregate_single( $aggregate, $scheduler );
685    }
686
687    return;
688}
689
690sub _add_descriptions {
691    my $self = shift;
692
693    # Turn unwrapped scalars into anonymous arrays and copy the name as
694    # the description for tests that have only a name.
695    return map { @$_ == 1 ? [ $_->[0], $_->[0] ] : $_ }
696      map { 'ARRAY' eq ref $_ ? $_ : [$_] } @_;
697}
698
699=head3 C<make_scheduler>
700
701Called by the harness when it needs to create a
702L<TAP::Parser::Scheduler>. Override in a subclass to provide an
703alternative scheduler. C<make_scheduler> is passed the list of tests
704that was passed to C<aggregate_tests>.
705
706=cut
707
708sub make_scheduler {
709    my ( $self, @tests ) = @_;
710    return $self->_construct(
711        $self->scheduler_class,
712        tests => [ $self->_add_descriptions(@tests) ],
713        rules => $self->rules
714    );
715}
716
717=head3 C<jobs>
718
719Gets or sets the number of concurrent test runs the harness is
720handling.  By default, this value is 1 -- for parallel testing, this
721should be set higher.
722
723=cut
724
725##############################################################################
726
727sub _get_parser_args {
728    my ( $self, $job ) = @_;
729    my $test_prog = $job->filename;
730    my %args      = ();
731
732    $args{sources} = $self->sources if $self->sources;
733
734    my @switches;
735    @switches = $self->lib if $self->lib;
736    push @switches => $self->switches if $self->switches;
737    $args{switches}    = \@switches;
738    $args{spool}       = $self->_open_spool($test_prog);
739    $args{merge}       = $self->merge;
740    $args{ignore_exit} = $self->ignore_exit;
741    $args{version}     = $self->version if $self->version;
742
743    if ( my $exec = $self->exec ) {
744        $args{exec}
745          = ref $exec eq 'CODE'
746          ? $exec->( $self, $test_prog )
747          : [ @$exec, $test_prog ];
748        if ( not defined $args{exec} ) {
749            $args{source} = $test_prog;
750        }
751        elsif ( ( ref( $args{exec} ) || "" ) ne "ARRAY" ) {
752            $args{source} = delete $args{exec};
753        }
754    }
755    else {
756        $args{source} = $test_prog;
757    }
758
759    if ( defined( my $test_args = $self->test_args ) ) {
760
761        if ( ref($test_args) eq 'HASH' ) {
762
763            # different args for each test
764            if ( exists( $test_args->{ $job->description } ) ) {
765                $test_args = $test_args->{ $job->description };
766            }
767            else {
768                $self->_croak( "TAP::Harness Can't find test_args for "
769                      . $job->description );
770            }
771        }
772
773        $args{test_args} = $test_args;
774    }
775
776    return \%args;
777}
778
779=head3 C<make_parser>
780
781Make a new parser and display formatter session. Typically used and/or
782overridden in subclasses.
783
784    my ( $parser, $session ) = $harness->make_parser;
785
786=cut
787
788sub make_parser {
789    my ( $self, $job ) = @_;
790
791    my $args = $self->_get_parser_args($job);
792    $self->_make_callback( 'parser_args', $args, $job->as_array_ref );
793    my $parser = $self->_construct( $self->parser_class, $args );
794
795    $self->_make_callback( 'made_parser', $parser, $job->as_array_ref );
796    my $session = $self->formatter->open_test( $job->description, $parser );
797
798    return ( $parser, $session );
799}
800
801=head3 C<finish_parser>
802
803Terminate use of a parser. Typically used and/or overridden in
804subclasses. The parser isn't destroyed as a result of this.
805
806=cut
807
808sub finish_parser {
809    my ( $self, $parser, $session ) = @_;
810
811    $session->close_test;
812    $self->_close_spool($parser);
813
814    return $parser;
815}
816
817sub _open_spool {
818    my $self = shift;
819    my $test = shift;
820
821    if ( my $spool_dir = $ENV{PERL_TEST_HARNESS_DUMP_TAP} ) {
822
823        my $spool = File::Spec->catfile( $spool_dir, $test );
824
825        # Make the directory
826        my ( $vol, $dir, undef ) = File::Spec->splitpath($spool);
827        my $path = File::Spec->catpath( $vol, $dir, '' );
828        eval { mkpath($path) };
829        $self->_croak($@) if $@;
830
831        my $spool_handle = IO::Handle->new;
832        open( $spool_handle, ">$spool" )
833          or $self->_croak(" Can't write $spool ( $! ) ");
834
835        return $spool_handle;
836    }
837
838    return;
839}
840
841sub _close_spool {
842    my $self = shift;
843    my ($parser) = @_;
844
845    if ( my $spool_handle = $parser->delete_spool ) {
846        close($spool_handle)
847          or $self->_croak(" Error closing TAP spool file( $! ) \n ");
848    }
849
850    return;
851}
852
853sub _croak {
854    my ( $self, $message ) = @_;
855    unless ($message) {
856        $message = $self->_error;
857    }
858    $self->SUPER::_croak($message);
859
860    return;
861}
862
8631;
864
865__END__
866
867##############################################################################
868
869=head1 CONFIGURING
870
871C<TAP::Harness> is designed to be easy to configure.
872
873=head2 Plugins
874
875C<TAP::Parser> plugins let you change the way TAP is I<input> to and I<output>
876from the parser.
877
878L<TAP::Parser::SourceHandler>s handle TAP I<input>.  You can configure them
879and load custom handlers using the C<sources> parameter to L</new>.
880
881L<TAP::Formatter>s handle TAP I<output>.  You can load custom formatters by
882using the C<formatter_class> parameter to L</new>.  To configure a formatter,
883you currently need to instantiate it outside of L<TAP::Harness> and pass it in
884with the C<formatter> parameter to L</new>.  This I<may> be addressed by adding
885a I<formatters> parameter to L</new> in the future.
886
887=head2 C<Module::Build>
888
889L<Module::Build> version C<0.30> supports C<TAP::Harness>.
890
891To load C<TAP::Harness> plugins, you'll need to use the C<tap_harness_args>
892parameter to C<new>, typically from your C<Build.PL>.  For example:
893
894  Module::Build->new(
895      module_name        => 'MyApp',
896      test_file_exts     => [qw(.t .tap .txt)],
897      use_tap_harness    => 1,
898      tap_harness_args   => {
899          sources => {
900              MyCustom => {},
901              File => {
902                  extensions => ['.tap', '.txt'],
903              },
904          },
905          formatter_class => 'TAP::Formatter::HTML',
906      },
907      build_requires     => {
908          'Module::Build' => '0.30',
909          'TAP::Harness'  => '3.18',
910      },
911  )->create_build_script;
912
913See L</new>
914
915=head2 C<ExtUtils::MakeMaker>
916
917L<ExtUtils::MakeMaker> does not support L<TAP::Harness> out-of-the-box.
918
919=head2 C<prove>
920
921L<prove> supports C<TAP::Harness> plugins, and has a plugin system of its
922own.  See L<prove/FORMATTERS>, L<prove/SOURCE HANDLERS> and L<App::Prove>
923for more details.
924
925=head1 WRITING PLUGINS
926
927If you can't configure C<TAP::Harness> to do what you want, and you can't find
928an existing plugin, consider writing one.
929
930The two primary use cases supported by L<TAP::Harness> for plugins are I<input>
931and I<output>:
932
933=over 2
934
935=item Customize how TAP gets into the parser
936
937To do this, you can either extend an existing L<TAP::Parser::SourceHandler>,
938or write your own.  It's a pretty simple API, and they can be loaded and
939configured using the C<sources> parameter to L</new>.
940
941=item Customize how TAP results are output from the parser
942
943To do this, you can either extend an existing L<TAP::Formatter>, or write your
944own.  Writing formatters are a bit more involved than writing a
945I<SourceHandler>, as you'll need to understand the L<TAP::Parser> API.  A
946good place to start is by understanding how L</aggregate_tests> works.
947
948Custom formatters can be loaded configured using the C<formatter_class>
949parameter to L</new>.
950
951=back
952
953=head1 SUBCLASSING
954
955If you can't configure C<TAP::Harness> to do exactly what you want, and writing
956a plugin isn't an option, consider extending it.  It is designed to be (mostly)
957easy to subclass, though the cases when sub-classing is necessary should be few
958and far between.
959
960=head2 Methods
961
962The following methods are ones you may wish to override if you want to
963subclass C<TAP::Harness>.
964
965=over 4
966
967=item L</new>
968
969=item L</runtests>
970
971=item L</summary>
972
973=back
974
975=cut
976
977=head1 REPLACING
978
979If you like the C<prove> utility and L<TAP::Parser> but you want your
980own harness, all you need to do is write one and provide C<new> and
981C<runtests> methods. Then you can use the C<prove> utility like so:
982
983 prove --harness My::Test::Harness
984
985Note that while C<prove> accepts a list of tests (or things to be
986tested), C<new> has a fairly rich set of arguments. You'll probably want
987to read over this code carefully to see how all of them are being used.
988
989=head1 SEE ALSO
990
991L<Test::Harness>
992
993=cut
994
995# vim:ts=4:sw=4:et:sta
996