xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Harness/lib/TAP/Harness.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1b39c5158Smillertpackage TAP::Harness;
2b39c5158Smillert
3b39c5158Smillertuse strict;
46fb12b70Safresh1use warnings;
5b39c5158Smillertuse Carp;
6b39c5158Smillert
7b39c5158Smillertuse File::Spec;
8b39c5158Smillertuse File::Path;
9b39c5158Smillertuse IO::Handle;
10b39c5158Smillert
116fb12b70Safresh1use base 'TAP::Base';
12b39c5158Smillert
13b39c5158Smillert=head1 NAME
14b39c5158Smillert
15b39c5158SmillertTAP::Harness - Run test scripts with statistics
16b39c5158Smillert
17b39c5158Smillert=head1 VERSION
18b39c5158Smillert
19*3d61058aSafresh1Version 3.48
20b39c5158Smillert
21b39c5158Smillert=cut
22b39c5158Smillert
23*3d61058aSafresh1our $VERSION = '3.48';
24b39c5158Smillert
25b39c5158Smillert$ENV{HARNESS_ACTIVE}  = 1;
26b39c5158Smillert$ENV{HARNESS_VERSION} = $VERSION;
27b39c5158Smillert
28b39c5158SmillertEND {
29b39c5158Smillert
30b39c5158Smillert    # For VMS.
31b39c5158Smillert    delete $ENV{HARNESS_ACTIVE};
32b39c5158Smillert    delete $ENV{HARNESS_VERSION};
33b39c5158Smillert}
34b39c5158Smillert
35b39c5158Smillert=head1 DESCRIPTION
36b39c5158Smillert
37b39c5158SmillertThis is a simple test harness which allows tests to be run and results
38b39c5158Smillertautomatically aggregated and output to STDOUT.
39b39c5158Smillert
40b39c5158Smillert=head1 SYNOPSIS
41b39c5158Smillert
42b39c5158Smillert use TAP::Harness;
43b39c5158Smillert my $harness = TAP::Harness->new( \%args );
44b39c5158Smillert $harness->runtests(@tests);
45b39c5158Smillert
46b39c5158Smillert=cut
47b39c5158Smillert
48b39c5158Smillertmy %VALIDATION_FOR;
49b39c5158Smillertmy @FORMATTER_ARGS;
50b39c5158Smillert
51b39c5158Smillertsub _error {
52b39c5158Smillert    my $self = shift;
53b39c5158Smillert    return $self->{error} unless @_;
54b39c5158Smillert    $self->{error} = shift;
55b39c5158Smillert}
56b39c5158Smillert
57b39c5158SmillertBEGIN {
58b39c5158Smillert
59b39c5158Smillert    @FORMATTER_ARGS = qw(
60b39c5158Smillert      directives verbosity timer failures comments errors stdout color
61b39c5158Smillert      show_count normalize
62b39c5158Smillert    );
63b39c5158Smillert
64b39c5158Smillert    %VALIDATION_FOR = (
65b39c5158Smillert        lib => sub {
66b39c5158Smillert            my ( $self, $libs ) = @_;
67b39c5158Smillert            $libs = [$libs] unless 'ARRAY' eq ref $libs;
68b39c5158Smillert
69b39c5158Smillert            return [ map {"-I$_"} @$libs ];
70b39c5158Smillert        },
71b39c5158Smillert        switches          => sub { shift; shift },
72b39c5158Smillert        exec              => sub { shift; shift },
73b39c5158Smillert        merge             => sub { shift; shift },
74b39c5158Smillert        aggregator_class  => sub { shift; shift },
75b39c5158Smillert        formatter_class   => sub { shift; shift },
76b39c5158Smillert        multiplexer_class => sub { shift; shift },
77b39c5158Smillert        parser_class      => sub { shift; shift },
78b39c5158Smillert        scheduler_class   => sub { shift; shift },
79b39c5158Smillert        formatter         => sub { shift; shift },
80b39c5158Smillert        jobs              => sub { shift; shift },
81b39c5158Smillert        test_args         => sub { shift; shift },
82b39c5158Smillert        ignore_exit       => sub { shift; shift },
83b39c5158Smillert        rules             => sub { shift; shift },
84b8851fccSafresh1        rulesfile         => sub { shift; shift },
85898184e3Ssthen        sources           => sub { shift; shift },
86898184e3Ssthen        version           => sub { shift; shift },
87898184e3Ssthen        trap              => sub { shift; shift },
88b39c5158Smillert    );
89b39c5158Smillert
90b39c5158Smillert    for my $method ( sort keys %VALIDATION_FOR ) {
91b39c5158Smillert        no strict 'refs';
92b39c5158Smillert        if ( $method eq 'lib' || $method eq 'switches' ) {
93b39c5158Smillert            *{$method} = sub {
94b39c5158Smillert                my $self = shift;
95b39c5158Smillert                unless (@_) {
96b39c5158Smillert                    $self->{$method} ||= [];
97b39c5158Smillert                    return wantarray
98b39c5158Smillert                      ? @{ $self->{$method} }
99b39c5158Smillert                      : $self->{$method};
100b39c5158Smillert                }
101b39c5158Smillert                $self->_croak("Too many arguments to method '$method'")
102b39c5158Smillert                  if @_ > 1;
103b39c5158Smillert                my $args = shift;
104b39c5158Smillert                $args = [$args] unless ref $args;
105b39c5158Smillert                $self->{$method} = $args;
106b39c5158Smillert                return $self;
107b39c5158Smillert            };
108b39c5158Smillert        }
109b39c5158Smillert        else {
110b39c5158Smillert            *{$method} = sub {
111b39c5158Smillert                my $self = shift;
112b39c5158Smillert                return $self->{$method} unless @_;
113b39c5158Smillert                $self->{$method} = shift;
114b39c5158Smillert            };
115b39c5158Smillert        }
116b39c5158Smillert    }
117b39c5158Smillert
118b39c5158Smillert    for my $method (@FORMATTER_ARGS) {
119b39c5158Smillert        no strict 'refs';
120b39c5158Smillert        *{$method} = sub {
121b39c5158Smillert            my $self = shift;
122b39c5158Smillert            return $self->formatter->$method(@_);
123b39c5158Smillert        };
124b39c5158Smillert    }
125b39c5158Smillert}
126b39c5158Smillert
127b39c5158Smillert##############################################################################
128b39c5158Smillert
129b39c5158Smillert=head1 METHODS
130b39c5158Smillert
131b39c5158Smillert=head2 Class Methods
132b39c5158Smillert
133b39c5158Smillert=head3 C<new>
134b39c5158Smillert
135b39c5158Smillert my %args = (
136b39c5158Smillert    verbosity => 1,
137b39c5158Smillert    lib     => [ 'lib', 'blib/lib', 'blib/arch' ],
138b39c5158Smillert )
139b39c5158Smillert my $harness = TAP::Harness->new( \%args );
140b39c5158Smillert
141b39c5158SmillertThe constructor returns a new C<TAP::Harness> object. It accepts an
142b39c5158Smillertoptional hashref whose allowed keys are:
143b39c5158Smillert
144b39c5158Smillert=over 4
145b39c5158Smillert
146b39c5158Smillert=item * C<verbosity>
147b39c5158Smillert
148b39c5158SmillertSet the verbosity level:
149b39c5158Smillert
150b39c5158Smillert     1   verbose        Print individual test results to STDOUT.
151b39c5158Smillert     0   normal
152b39c5158Smillert    -1   quiet          Suppress some test output (mostly failures
153b39c5158Smillert                        while tests are running).
154b39c5158Smillert    -2   really quiet   Suppress everything but the tests summary.
155b39c5158Smillert    -3   silent         Suppress everything.
156b39c5158Smillert
157b39c5158Smillert=item * C<timer>
158b39c5158Smillert
159b39c5158SmillertAppend run time for each test to output. Uses L<Time::HiRes> if
160b39c5158Smillertavailable.
161b39c5158Smillert
162b39c5158Smillert=item * C<failures>
163b39c5158Smillert
164b39c5158SmillertShow test failures (this is a no-op if C<verbose> is selected).
165b39c5158Smillert
166b39c5158Smillert=item * C<comments>
167b39c5158Smillert
168b39c5158SmillertShow test comments (this is a no-op if C<verbose> is selected).
169b39c5158Smillert
170b39c5158Smillert=item * C<show_count>
171b39c5158Smillert
172b39c5158SmillertUpdate the running test count during testing.
173b39c5158Smillert
174b39c5158Smillert=item * C<normalize>
175b39c5158Smillert
176b39c5158SmillertSet to a true value to normalize the TAP that is emitted in verbose modes.
177b39c5158Smillert
178b39c5158Smillert=item * C<lib>
179b39c5158Smillert
180b39c5158SmillertAccepts a scalar value or array ref of scalar values indicating which
181b39c5158Smillertpaths to allowed libraries should be included if Perl tests are
182b39c5158Smillertexecuted. Naturally, this only makes sense in the context of tests
183b39c5158Smillertwritten in Perl.
184b39c5158Smillert
185b39c5158Smillert=item * C<switches>
186b39c5158Smillert
187b39c5158SmillertAccepts a scalar value or array ref of scalar values indicating which
188b39c5158Smillertswitches should be included if Perl tests are executed. Naturally, this
189b39c5158Smillertonly makes sense in the context of tests written in Perl.
190b39c5158Smillert
191b39c5158Smillert=item * C<test_args>
192b39c5158Smillert
193b39c5158SmillertA reference to an C<@INC> style array of arguments to be passed to each
194b39c5158Smillerttest program.
195b39c5158Smillert
196898184e3Ssthen  test_args => ['foo', 'bar'],
197898184e3Ssthen
198898184e3Ssthenif you want to pass different arguments to each test then you should
199898184e3Ssthenpass a hash of arrays, keyed by the alias for each test:
200898184e3Ssthen
201898184e3Ssthen  test_args => {
202898184e3Ssthen    my_test    => ['foo', 'bar'],
203898184e3Ssthen    other_test => ['baz'],
204898184e3Ssthen  }
205898184e3Ssthen
206b39c5158Smillert=item * C<color>
207b39c5158Smillert
208b39c5158SmillertAttempt to produce color output.
209b39c5158Smillert
210b39c5158Smillert=item * C<exec>
211b39c5158Smillert
212b39c5158SmillertTypically, Perl tests are run through this. However, anything which
213b39c5158Smillertspits out TAP is fine. You can use this argument to specify the name of
214b39c5158Smillertthe program (and optional switches) to run your tests with:
215b39c5158Smillert
216b39c5158Smillert  exec => ['/usr/bin/ruby', '-w']
217b39c5158Smillert
218b39c5158SmillertYou can also pass a subroutine reference in order to determine and
219b39c5158Smillertreturn the proper program to run based on a given test script. The
220b39c5158Smillertsubroutine reference should expect the TAP::Harness object itself as the
221b39c5158Smillertfirst argument, and the file name as the second argument. It should
222b39c5158Smillertreturn an array reference containing the command to be run and including
223b39c5158Smillertthe test file name. It can also simply return C<undef>, in which case
224b39c5158SmillertTAP::Harness will fall back on executing the test script in Perl:
225b39c5158Smillert
226b39c5158Smillert    exec => sub {
227b39c5158Smillert        my ( $harness, $test_file ) = @_;
228b39c5158Smillert
229b39c5158Smillert        # Let Perl tests run.
230b39c5158Smillert        return undef if $test_file =~ /[.]t$/;
231b39c5158Smillert        return [ qw( /usr/bin/ruby -w ), $test_file ]
232b39c5158Smillert          if $test_file =~ /[.]rb$/;
233b39c5158Smillert      }
234b39c5158Smillert
235b39c5158SmillertIf the subroutine returns a scalar with a newline or a filehandle, it
236b39c5158Smillertwill be interpreted as raw TAP or as a TAP stream, respectively.
237b39c5158Smillert
238b39c5158Smillert=item * C<merge>
239b39c5158Smillert
240b39c5158SmillertIf C<merge> is true the harness will create parsers that merge STDOUT
241b39c5158Smillertand STDERR together for any processes they start.
242b39c5158Smillert
243898184e3Ssthen=item * C<sources>
244898184e3Ssthen
245898184e3SsthenI<NEW to 3.18>.
246898184e3Ssthen
247898184e3SsthenIf set, C<sources> must be a hashref containing the names of the
248898184e3SsthenL<TAP::Parser::SourceHandler>s to load and/or configure.  The values are a
2496fb12b70Safresh1hash of configuration that will be accessible to the source handlers via
250898184e3SsthenL<TAP::Parser::Source/config_for>.
251898184e3Ssthen
252898184e3SsthenFor example:
253898184e3Ssthen
254898184e3Ssthen  sources => {
255898184e3Ssthen    Perl => { exec => '/path/to/custom/perl' },
256898184e3Ssthen    File => { extensions => [ '.tap', '.txt' ] },
257898184e3Ssthen    MyCustom => { some => 'config' },
258898184e3Ssthen  }
259898184e3Ssthen
260898184e3SsthenThe C<sources> parameter affects how C<source>, C<tap> and C<exec> parameters
261898184e3Ssthenare handled.
262898184e3Ssthen
263898184e3SsthenFor more details, see the C<sources> parameter in L<TAP::Parser/new>,
264898184e3SsthenL<TAP::Parser::Source>, and L<TAP::Parser::IteratorFactory>.
265898184e3Ssthen
266b39c5158Smillert=item * C<aggregator_class>
267b39c5158Smillert
268b39c5158SmillertThe name of the class to use to aggregate test results. The default is
269b39c5158SmillertL<TAP::Parser::Aggregator>.
270b39c5158Smillert
271898184e3Ssthen=item * C<version>
272898184e3Ssthen
273898184e3SsthenI<NEW to 3.22>.
274898184e3Ssthen
275898184e3SsthenAssume this TAP version for L<TAP::Parser> instead of default TAP
276898184e3Ssthenversion 12.
277898184e3Ssthen
278b39c5158Smillert=item * C<formatter_class>
279b39c5158Smillert
280b39c5158SmillertThe name of the class to use to format output. The default is
281b39c5158SmillertL<TAP::Formatter::Console>, or L<TAP::Formatter::File> if the output
282b39c5158Smillertisn't a TTY.
283b39c5158Smillert
284b39c5158Smillert=item * C<multiplexer_class>
285b39c5158Smillert
286b39c5158SmillertThe name of the class to use to multiplex tests during parallel testing.
287b39c5158SmillertThe default is L<TAP::Parser::Multiplexer>.
288b39c5158Smillert
289b39c5158Smillert=item * C<parser_class>
290b39c5158Smillert
291b39c5158SmillertThe name of the class to use to parse TAP. The default is
292b39c5158SmillertL<TAP::Parser>.
293b39c5158Smillert
294b39c5158Smillert=item * C<scheduler_class>
295b39c5158Smillert
296b39c5158SmillertThe name of the class to use to schedule test execution. The default is
297b39c5158SmillertL<TAP::Parser::Scheduler>.
298b39c5158Smillert
299b39c5158Smillert=item * C<formatter>
300b39c5158Smillert
301b39c5158SmillertIf set C<formatter> must be an object that is capable of formatting the
302b39c5158SmillertTAP output. See L<TAP::Formatter::Console> for an example.
303b39c5158Smillert
304b39c5158Smillert=item * C<errors>
305b39c5158Smillert
306b39c5158SmillertIf parse errors are found in the TAP output, a note of this will be
307b39c5158Smillertmade in the summary report. To see all of the parse errors, set this
308b39c5158Smillertargument to true:
309b39c5158Smillert
310b39c5158Smillert  errors => 1
311b39c5158Smillert
312b39c5158Smillert=item * C<directives>
313b39c5158Smillert
314b39c5158SmillertIf set to a true value, only test results with directives will be
315b39c5158Smillertdisplayed. This overrides other settings such as C<verbose> or
316b39c5158SmillertC<failures>.
317b39c5158Smillert
318b39c5158Smillert=item * C<ignore_exit>
319b39c5158Smillert
320b39c5158SmillertIf set to a true value instruct C<TAP::Parser> to ignore exit and wait
321b39c5158Smillertstatus from test scripts.
322b39c5158Smillert
323b39c5158Smillert=item * C<jobs>
324b39c5158Smillert
325b39c5158SmillertThe maximum number of parallel tests to run at any time.  Which tests
326b39c5158Smillertcan be run in parallel is controlled by C<rules>.  The default is to
327b39c5158Smillertrun only one test at a time.
328b39c5158Smillert
329b39c5158Smillert=item * C<rules>
330b39c5158Smillert
3316fb12b70Safresh1A reference to a hash of rules that control which tests may be executed in
332b8851fccSafresh1parallel. If no rules are declared and L<CPAN::Meta::YAML> is available,
333b8851fccSafresh1C<TAP::Harness> attempts to load rules from a YAML file specified by the
334b8851fccSafresh1C<rulesfile> parameter. If no rules file exists, the default is for all
335b8851fccSafresh1tests to be eligible to be run in parallel.
336b8851fccSafresh1
337b8851fccSafresh1Here some simple examples. For the full details of the data structure
3386fb12b70Safresh1and the related glob-style pattern matching, see
3396fb12b70Safresh1L<TAP::Parser::Scheduler/"Rules data structure">.
340b39c5158Smillert
3416fb12b70Safresh1    # Run all tests in sequence, except those starting with "p"
3426fb12b70Safresh1    $harness->rules({
3436fb12b70Safresh1        par => 't/p*.t'
3446fb12b70Safresh1    });
3456fb12b70Safresh1
346b8851fccSafresh1    # Equivalent YAML file
347b8851fccSafresh1    ---
348b8851fccSafresh1    par: t/p*.t
349b8851fccSafresh1
3506fb12b70Safresh1    # Run all tests in parallel, except those starting with "p"
3516fb12b70Safresh1    $harness->rules({
3526fb12b70Safresh1        seq => [
3536fb12b70Safresh1                  { seq => 't/p*.t' },
3546fb12b70Safresh1                  { par => '**'     },
3556fb12b70Safresh1               ],
3566fb12b70Safresh1    });
3576fb12b70Safresh1
358b8851fccSafresh1    # Equivalent YAML file
359b8851fccSafresh1    ---
360b8851fccSafresh1    seq:
361b8851fccSafresh1        - seq: t/p*.t
362b8851fccSafresh1        - par: **
363b8851fccSafresh1
3646fb12b70Safresh1    # Run some  startup tests in sequence, then some parallel tests than some
3656fb12b70Safresh1    # teardown tests in sequence.
3666fb12b70Safresh1    $harness->rules({
3676fb12b70Safresh1        seq => [
3686fb12b70Safresh1            { seq => 't/startup/*.t' },
3696fb12b70Safresh1            { par => ['t/a/*.t','t/b/*.t','t/c/*.t'], }
3706fb12b70Safresh1            { seq => 't/shutdown/*.t' },
3716fb12b70Safresh1        ],
3726fb12b70Safresh1
3736fb12b70Safresh1    });
3746fb12b70Safresh1
375b8851fccSafresh1    # Equivalent YAML file
376b8851fccSafresh1    ---
377b8851fccSafresh1    seq:
378b8851fccSafresh1        - seq: t/startup/*.t
379b8851fccSafresh1        - par:
380b8851fccSafresh1            - t/a/*.t
381b8851fccSafresh1            - t/b/*.t
382b8851fccSafresh1            - t/c/*.t
383b8851fccSafresh1        - seq: t/shutdown/*.t
384b8851fccSafresh1
3856fb12b70Safresh1This is an experimental feature and the interface may change.
386b39c5158Smillert
387b8851fccSafresh1=item * C<rulesfiles>
388b8851fccSafresh1
389b8851fccSafresh1This specifies where to find a YAML file of test scheduling rules.  If not
390b8851fccSafresh1provided, it looks for a default file to use.  It first checks for a file given
391b8851fccSafresh1in the C<HARNESS_RULESFILE> environment variable, then it checks for
392b8851fccSafresh1F<testrules.yml> and then F<t/testrules.yml>.
393b8851fccSafresh1
394b39c5158Smillert=item * C<stdout>
395b39c5158Smillert
396b39c5158SmillertA filehandle for catching standard output.
397b39c5158Smillert
398898184e3Ssthen=item * C<trap>
399898184e3Ssthen
400898184e3SsthenAttempt to print summary information if run is interrupted by
401898184e3SsthenSIGINT (Ctrl-C).
402898184e3Ssthen
403b39c5158Smillert=back
404b39c5158Smillert
405b39c5158SmillertAny keys for which the value is C<undef> will be ignored.
406b39c5158Smillert
407b39c5158Smillert=cut
408b39c5158Smillert
409b39c5158Smillert# new supplied by TAP::Base
410b39c5158Smillert
411b39c5158Smillert{
412b39c5158Smillert    my @legal_callback = qw(
413b39c5158Smillert      parser_args
414b39c5158Smillert      made_parser
415b39c5158Smillert      before_runtests
416b39c5158Smillert      after_runtests
417b39c5158Smillert      after_test
418b39c5158Smillert    );
419b39c5158Smillert
420b39c5158Smillert    my %default_class = (
421b39c5158Smillert        aggregator_class  => 'TAP::Parser::Aggregator',
422b39c5158Smillert        formatter_class   => 'TAP::Formatter::Console',
423b39c5158Smillert        multiplexer_class => 'TAP::Parser::Multiplexer',
424b39c5158Smillert        parser_class      => 'TAP::Parser',
425b39c5158Smillert        scheduler_class   => 'TAP::Parser::Scheduler',
426b39c5158Smillert    );
427b39c5158Smillert
428b39c5158Smillert    sub _initialize {
429b39c5158Smillert        my ( $self, $arg_for ) = @_;
430b39c5158Smillert        $arg_for ||= {};
431b39c5158Smillert
432b39c5158Smillert        $self->SUPER::_initialize( $arg_for, \@legal_callback );
433b39c5158Smillert        my %arg_for = %$arg_for;    # force a shallow copy
434b39c5158Smillert
435b39c5158Smillert        for my $name ( sort keys %VALIDATION_FOR ) {
436b39c5158Smillert            my $property = delete $arg_for{$name};
437b39c5158Smillert            if ( defined $property ) {
438b39c5158Smillert                my $validate = $VALIDATION_FOR{$name};
439b39c5158Smillert
440b39c5158Smillert                my $value = $self->$validate($property);
441b39c5158Smillert                if ( $self->_error ) {
442b39c5158Smillert                    $self->_croak;
443b39c5158Smillert                }
444b39c5158Smillert                $self->$name($value);
445b39c5158Smillert            }
446b39c5158Smillert        }
447b39c5158Smillert
448b39c5158Smillert        $self->jobs(1) unless defined $self->jobs;
449b39c5158Smillert
450b8851fccSafresh1        if ( ! defined $self->rules ) {
451b8851fccSafresh1            $self->_maybe_load_rulesfile;
452b8851fccSafresh1        }
453b8851fccSafresh1
454b39c5158Smillert        local $default_class{formatter_class} = 'TAP::Formatter::File'
455b39c5158Smillert          unless -t ( $arg_for{stdout} || \*STDOUT ) && !$ENV{HARNESS_NOTTY};
456b39c5158Smillert
457b39c5158Smillert        while ( my ( $attr, $class ) = each %default_class ) {
458b39c5158Smillert            $self->$attr( $self->$attr() || $class );
459b39c5158Smillert        }
460b39c5158Smillert
461b39c5158Smillert        unless ( $self->formatter ) {
462b39c5158Smillert
463b39c5158Smillert            # This is a little bodge to preserve legacy behaviour. It's
464b39c5158Smillert            # pretty horrible that we know which args are destined for
465b39c5158Smillert            # the formatter.
466b39c5158Smillert            my %formatter_args = ( jobs => $self->jobs );
467b39c5158Smillert            for my $name (@FORMATTER_ARGS) {
468b39c5158Smillert                if ( defined( my $property = delete $arg_for{$name} ) ) {
469b39c5158Smillert                    $formatter_args{$name} = $property;
470b39c5158Smillert                }
471b39c5158Smillert            }
472b39c5158Smillert
473b39c5158Smillert            $self->formatter(
474b39c5158Smillert                $self->_construct( $self->formatter_class, \%formatter_args )
475b39c5158Smillert            );
476b39c5158Smillert        }
477b39c5158Smillert
478b39c5158Smillert        if ( my @props = sort keys %arg_for ) {
479b39c5158Smillert            $self->_croak("Unknown arguments to TAP::Harness::new (@props)");
480b39c5158Smillert        }
481b39c5158Smillert
482b39c5158Smillert        return $self;
483b39c5158Smillert    }
484b8851fccSafresh1
485b8851fccSafresh1    sub _maybe_load_rulesfile {
486b8851fccSafresh1        my ($self) = @_;
487b8851fccSafresh1
488b8851fccSafresh1        my ($rulesfile) =   defined $self->rulesfile ? $self->rulesfile :
489b8851fccSafresh1                            defined($ENV{HARNESS_RULESFILE}) ? $ENV{HARNESS_RULESFILE} :
490b8851fccSafresh1                            grep { -r } qw(./testrules.yml t/testrules.yml);
491b8851fccSafresh1
492b8851fccSafresh1        if ( defined $rulesfile && -r $rulesfile ) {
493b8851fccSafresh1            if ( ! eval { require CPAN::Meta::YAML; 1} ) {
494b8851fccSafresh1               warn "CPAN::Meta::YAML required to process $rulesfile" ;
495b8851fccSafresh1               return;
496b8851fccSafresh1            }
497b8851fccSafresh1            my $layer = $] lt "5.008" ? "" : ":encoding(UTF-8)";
498b8851fccSafresh1            open my $fh, "<$layer", $rulesfile
499b8851fccSafresh1                or die "Couldn't open $rulesfile: $!";
500b8851fccSafresh1            my $yaml_text = do { local $/; <$fh> };
501b8851fccSafresh1            my $yaml = CPAN::Meta::YAML->read_string($yaml_text)
502b8851fccSafresh1                or die CPAN::Meta::YAML->errstr;
503b8851fccSafresh1            $self->rules( $yaml->[0] );
504b8851fccSafresh1        }
505b8851fccSafresh1        return;
506b8851fccSafresh1    }
507b39c5158Smillert}
508b39c5158Smillert
509b39c5158Smillert##############################################################################
510b39c5158Smillert
511b39c5158Smillert=head2 Instance Methods
512b39c5158Smillert
513b39c5158Smillert=head3 C<runtests>
514b39c5158Smillert
515b39c5158Smillert    $harness->runtests(@tests);
516b39c5158Smillert
517898184e3SsthenAccepts an array of C<@tests> to be run. This should generally be the
518b39c5158Smillertnames of test files, but this is not required. Each element in C<@tests>
519b39c5158Smillertwill be passed to C<TAP::Parser::new()> as a C<source>. See
520b39c5158SmillertL<TAP::Parser> for more information.
521b39c5158Smillert
522b39c5158SmillertIt is possible to provide aliases that will be displayed in place of the
523b39c5158Smillerttest name by supplying the test as a reference to an array containing
524b39c5158SmillertC<< [ $test, $alias ] >>:
525b39c5158Smillert
526b39c5158Smillert    $harness->runtests( [ 't/foo.t', 'Foo Once' ],
527b39c5158Smillert                        [ 't/foo.t', 'Foo Twice' ] );
528b39c5158Smillert
529b39c5158SmillertNormally it is an error to attempt to run the same test twice. Aliases
530b39c5158Smillertallow you to overcome this limitation by giving each run of the test a
531b39c5158Smillertunique name.
532b39c5158Smillert
533b39c5158SmillertTests will be run in the order found.
534b39c5158Smillert
535b39c5158SmillertIf the environment variable C<PERL_TEST_HARNESS_DUMP_TAP> is defined it
536b39c5158Smillertshould name a directory into which a copy of the raw TAP for each test
537b39c5158Smillertwill be written. TAP is written to files named for each test.
538b39c5158SmillertSubdirectories will be created as needed.
539b39c5158Smillert
540b39c5158SmillertReturns a L<TAP::Parser::Aggregator> containing the test results.
541b39c5158Smillert
542b39c5158Smillert=cut
543b39c5158Smillert
544b39c5158Smillertsub runtests {
545b39c5158Smillert    my ( $self, @tests ) = @_;
546b39c5158Smillert
547b39c5158Smillert    my $aggregate = $self->_construct( $self->aggregator_class );
548b39c5158Smillert
549b39c5158Smillert    $self->_make_callback( 'before_runtests', $aggregate );
550b39c5158Smillert    $aggregate->start;
551898184e3Ssthen    my $finish = sub {
552898184e3Ssthen        my $interrupted = shift;
553b39c5158Smillert        $aggregate->stop;
554898184e3Ssthen        $self->summary( $aggregate, $interrupted );
555b39c5158Smillert        $self->_make_callback( 'after_runtests', $aggregate );
556898184e3Ssthen    };
557898184e3Ssthen    my $run = sub {
558eac174f2Safresh1        my $bailout;
559eac174f2Safresh1        eval { $self->aggregate_tests( $aggregate, @tests ); 1 }
560eac174f2Safresh1            or do { $bailout = $@ || 'unknown_error' };
561898184e3Ssthen        $finish->();
562eac174f2Safresh1        die $bailout if defined $bailout;
563898184e3Ssthen    };
564*3d61058aSafresh1    $self->{bail_summary} = sub{
565*3d61058aSafresh1        print "\n";
566*3d61058aSafresh1        $finish->(1);
567*3d61058aSafresh1    };
568898184e3Ssthen
569898184e3Ssthen    if ( $self->trap ) {
570898184e3Ssthen        local $SIG{INT} = sub {
571898184e3Ssthen            print "\n";
572898184e3Ssthen            $finish->(1);
573898184e3Ssthen            exit;
574898184e3Ssthen        };
575898184e3Ssthen        $run->();
576898184e3Ssthen    }
577898184e3Ssthen    else {
578898184e3Ssthen        $run->();
579898184e3Ssthen    }
580b39c5158Smillert
581b39c5158Smillert    return $aggregate;
582b39c5158Smillert}
583b39c5158Smillert
584b39c5158Smillert=head3 C<summary>
585b39c5158Smillert
586898184e3Ssthen  $harness->summary( $aggregator );
587898184e3Ssthen
588898184e3SsthenOutput the summary for a L<TAP::Parser::Aggregator>.
589b39c5158Smillert
590b39c5158Smillert=cut
591b39c5158Smillert
592b39c5158Smillertsub summary {
593898184e3Ssthen    my ( $self, @args ) = @_;
594898184e3Ssthen    $self->formatter->summary(@args);
595b39c5158Smillert}
596b39c5158Smillert
597b39c5158Smillertsub _after_test {
598b39c5158Smillert    my ( $self, $aggregate, $job, $parser ) = @_;
599b39c5158Smillert
600b39c5158Smillert    $self->_make_callback( 'after_test', $job->as_array_ref, $parser );
601b39c5158Smillert    $aggregate->add( $job->description, $parser );
602b39c5158Smillert}
603b39c5158Smillert
604b39c5158Smillertsub _bailout {
605eac174f2Safresh1    my ( $self, $result, $parser, $session, $aggregate, $job ) = @_;
606eac174f2Safresh1
607eac174f2Safresh1    $self->finish_parser( $parser, $session );
608eac174f2Safresh1    $self->_after_test( $aggregate, $job, $parser );
609eac174f2Safresh1    $job->finish;
610eac174f2Safresh1
611b39c5158Smillert    my $explanation = $result->explanation;
612*3d61058aSafresh1    $self->{bail_summary}();
613b39c5158Smillert    die "FAILED--Further testing stopped"
614b39c5158Smillert      . ( $explanation ? ": $explanation\n" : ".\n" );
615b39c5158Smillert}
616b39c5158Smillert
617b39c5158Smillertsub _aggregate_parallel {
618b39c5158Smillert    my ( $self, $aggregate, $scheduler ) = @_;
619b39c5158Smillert
620b39c5158Smillert    my $jobs = $self->jobs;
621b39c5158Smillert    my $mux  = $self->_construct( $self->multiplexer_class );
622b39c5158Smillert
623b39c5158Smillert    RESULT: {
624b39c5158Smillert
625b39c5158Smillert        # Keep multiplexer topped up
626b39c5158Smillert        FILL:
627b39c5158Smillert        while ( $mux->parsers < $jobs ) {
628b39c5158Smillert            my $job = $scheduler->get_job;
629b39c5158Smillert
630b39c5158Smillert            # If we hit a spinner stop filling and start running.
631b39c5158Smillert            last FILL if !defined $job || $job->is_spinner;
632b39c5158Smillert
633b39c5158Smillert            my ( $parser, $session ) = $self->make_parser($job);
634b39c5158Smillert            $mux->add( $parser, [ $session, $job ] );
635eac174f2Safresh1
636eac174f2Safresh1            # The job has started: begin the timers
637eac174f2Safresh1            $parser->start_time( $parser->get_time );
638eac174f2Safresh1            $parser->start_times( $parser->get_times );
639b39c5158Smillert        }
640b39c5158Smillert
641b39c5158Smillert        if ( my ( $parser, $stash, $result ) = $mux->next ) {
642b39c5158Smillert            my ( $session, $job ) = @$stash;
643b39c5158Smillert            if ( defined $result ) {
644b39c5158Smillert                $session->result($result);
645eac174f2Safresh1                $self->_bailout($result, $parser, $session, $aggregate, $job )
646eac174f2Safresh1                    if $result->is_bailout;
647b39c5158Smillert            }
648b39c5158Smillert            else {
649b39c5158Smillert
650b39c5158Smillert                # End of parser. Automatically removed from the mux.
651b39c5158Smillert                $self->finish_parser( $parser, $session );
652b39c5158Smillert                $self->_after_test( $aggregate, $job, $parser );
653b39c5158Smillert                $job->finish;
654b39c5158Smillert            }
655b39c5158Smillert            redo RESULT;
656b39c5158Smillert        }
657b39c5158Smillert    }
658b39c5158Smillert
659b39c5158Smillert    return;
660b39c5158Smillert}
661b39c5158Smillert
662b39c5158Smillertsub _aggregate_single {
663b39c5158Smillert    my ( $self, $aggregate, $scheduler ) = @_;
664b39c5158Smillert
665b39c5158Smillert    JOB:
666b39c5158Smillert    while ( my $job = $scheduler->get_job ) {
667b39c5158Smillert        next JOB if $job->is_spinner;
668b39c5158Smillert
669b39c5158Smillert        my ( $parser, $session ) = $self->make_parser($job);
670b39c5158Smillert
671b39c5158Smillert        while ( defined( my $result = $parser->next ) ) {
672b39c5158Smillert            $session->result($result);
673b39c5158Smillert            if ( $result->is_bailout ) {
674b39c5158Smillert
675b39c5158Smillert                # Keep reading until input is exhausted in the hope
676b39c5158Smillert                # of allowing any pending diagnostics to show up.
677b39c5158Smillert                1 while $parser->next;
678eac174f2Safresh1                $self->_bailout($result, $parser, $session, $aggregate, $job );
679b39c5158Smillert            }
680b39c5158Smillert        }
681b39c5158Smillert
682b39c5158Smillert        $self->finish_parser( $parser, $session );
683b39c5158Smillert        $self->_after_test( $aggregate, $job, $parser );
684b39c5158Smillert        $job->finish;
685b39c5158Smillert    }
686b39c5158Smillert
687b39c5158Smillert    return;
688b39c5158Smillert}
689b39c5158Smillert
690b39c5158Smillert=head3 C<aggregate_tests>
691b39c5158Smillert
692b39c5158Smillert  $harness->aggregate_tests( $aggregate, @tests );
693b39c5158Smillert
694b39c5158SmillertRun the named tests and display a summary of result. Tests will be run
695b39c5158Smillertin the order found.
696b39c5158Smillert
697b39c5158SmillertTest results will be added to the supplied L<TAP::Parser::Aggregator>.
698b39c5158SmillertC<aggregate_tests> may be called multiple times to run several sets of
699b39c5158Smillerttests. Multiple C<Test::Harness> instances may be used to pass results
700b39c5158Smillertto a single aggregator so that different parts of a complex test suite
701b39c5158Smillertmay be run using different C<TAP::Harness> settings. This is useful, for
702b39c5158Smillertexample, in the case where some tests should run in parallel but others
703b39c5158Smillertare unsuitable for parallel execution.
704b39c5158Smillert
705b39c5158Smillert    my $formatter   = TAP::Formatter::Console->new;
706b39c5158Smillert    my $ser_harness = TAP::Harness->new( { formatter => $formatter } );
707b39c5158Smillert    my $par_harness = TAP::Harness->new(
708b39c5158Smillert        {   formatter => $formatter,
709b39c5158Smillert            jobs      => 9
710b39c5158Smillert        }
711b39c5158Smillert    );
712b39c5158Smillert    my $aggregator = TAP::Parser::Aggregator->new;
713b39c5158Smillert
714b39c5158Smillert    $aggregator->start();
715b39c5158Smillert    $ser_harness->aggregate_tests( $aggregator, @ser_tests );
716b39c5158Smillert    $par_harness->aggregate_tests( $aggregator, @par_tests );
717b39c5158Smillert    $aggregator->stop();
718b39c5158Smillert    $formatter->summary($aggregator);
719b39c5158Smillert
720b39c5158SmillertNote that for simpler testing requirements it will often be possible to
721b39c5158Smillertreplace the above code with a single call to C<runtests>.
722b39c5158Smillert
723898184e3SsthenEach element of the C<@tests> array is either:
724b39c5158Smillert
725b39c5158Smillert=over
726b39c5158Smillert
727898184e3Ssthen=item * the source name of a test to run
728b39c5158Smillert
729898184e3Ssthen=item * a reference to a [ source name, display name ] array
730b39c5158Smillert
731b39c5158Smillert=back
732b39c5158Smillert
733898184e3SsthenIn the case of a perl test suite, typically I<source names> are simply the file
734898184e3Ssthennames of the test scripts to run.
735898184e3Ssthen
736b39c5158SmillertWhen you supply a separate display name it becomes possible to run a
737b39c5158Smillerttest more than once; the display name is effectively the alias by which
738b39c5158Smillertthe test is known inside the harness. The harness doesn't care if it
739898184e3Ssthenruns the same test more than once when each invocation uses a
740b39c5158Smillertdifferent name.
741b39c5158Smillert
742b39c5158Smillert=cut
743b39c5158Smillert
744b39c5158Smillertsub aggregate_tests {
745b39c5158Smillert    my ( $self, $aggregate, @tests ) = @_;
746b39c5158Smillert
747b39c5158Smillert    my $jobs      = $self->jobs;
748b39c5158Smillert    my $scheduler = $self->make_scheduler(@tests);
749b39c5158Smillert
750b39c5158Smillert    # #12458
751b39c5158Smillert    local $ENV{HARNESS_IS_VERBOSE} = 1
752b39c5158Smillert      if $self->formatter->verbosity > 0;
753b39c5158Smillert
754b39c5158Smillert    # Formatter gets only names.
755b39c5158Smillert    $self->formatter->prepare( map { $_->description } $scheduler->get_all );
756b39c5158Smillert
757b39c5158Smillert    if ( $self->jobs > 1 ) {
758b39c5158Smillert        $self->_aggregate_parallel( $aggregate, $scheduler );
759b39c5158Smillert    }
760b39c5158Smillert    else {
761b39c5158Smillert        $self->_aggregate_single( $aggregate, $scheduler );
762b39c5158Smillert    }
763b39c5158Smillert
764b39c5158Smillert    return;
765b39c5158Smillert}
766b39c5158Smillert
767b39c5158Smillertsub _add_descriptions {
768b39c5158Smillert    my $self = shift;
769b39c5158Smillert
770b39c5158Smillert    # Turn unwrapped scalars into anonymous arrays and copy the name as
771b39c5158Smillert    # the description for tests that have only a name.
772b39c5158Smillert    return map { @$_ == 1 ? [ $_->[0], $_->[0] ] : $_ }
773b39c5158Smillert      map { 'ARRAY' eq ref $_ ? $_ : [$_] } @_;
774b39c5158Smillert}
775b39c5158Smillert
776b39c5158Smillert=head3 C<make_scheduler>
777b39c5158Smillert
778b39c5158SmillertCalled by the harness when it needs to create a
779b39c5158SmillertL<TAP::Parser::Scheduler>. Override in a subclass to provide an
780b39c5158Smillertalternative scheduler. C<make_scheduler> is passed the list of tests
781b39c5158Smillertthat was passed to C<aggregate_tests>.
782b39c5158Smillert
783b39c5158Smillert=cut
784b39c5158Smillert
785b39c5158Smillertsub make_scheduler {
786b39c5158Smillert    my ( $self, @tests ) = @_;
787b39c5158Smillert    return $self->_construct(
788b39c5158Smillert        $self->scheduler_class,
789b39c5158Smillert        tests => [ $self->_add_descriptions(@tests) ],
790b39c5158Smillert        rules => $self->rules
791b39c5158Smillert    );
792b39c5158Smillert}
793b39c5158Smillert
794b39c5158Smillert=head3 C<jobs>
795b39c5158Smillert
796b39c5158SmillertGets or sets the number of concurrent test runs the harness is
797b39c5158Smillerthandling.  By default, this value is 1 -- for parallel testing, this
798b39c5158Smillertshould be set higher.
799b39c5158Smillert
800b39c5158Smillert=cut
801b39c5158Smillert
802b39c5158Smillert##############################################################################
803b39c5158Smillert
804b39c5158Smillertsub _get_parser_args {
805b39c5158Smillert    my ( $self, $job ) = @_;
806b39c5158Smillert    my $test_prog = $job->filename;
807b39c5158Smillert    my %args      = ();
808898184e3Ssthen
809898184e3Ssthen    $args{sources} = $self->sources if $self->sources;
810898184e3Ssthen
811b39c5158Smillert    my @switches;
812b39c5158Smillert    @switches = $self->lib if $self->lib;
813b39c5158Smillert    push @switches => $self->switches if $self->switches;
814b39c5158Smillert    $args{switches}    = \@switches;
815b39c5158Smillert    $args{spool}       = $self->_open_spool($test_prog);
816b39c5158Smillert    $args{merge}       = $self->merge;
817b39c5158Smillert    $args{ignore_exit} = $self->ignore_exit;
818898184e3Ssthen    $args{version}     = $self->version if $self->version;
819b39c5158Smillert
820b39c5158Smillert    if ( my $exec = $self->exec ) {
821b39c5158Smillert        $args{exec}
822b39c5158Smillert          = ref $exec eq 'CODE'
823b39c5158Smillert          ? $exec->( $self, $test_prog )
824b39c5158Smillert          : [ @$exec, $test_prog ];
825b39c5158Smillert        if ( not defined $args{exec} ) {
826b39c5158Smillert            $args{source} = $test_prog;
827b39c5158Smillert        }
828b39c5158Smillert        elsif ( ( ref( $args{exec} ) || "" ) ne "ARRAY" ) {
829b39c5158Smillert            $args{source} = delete $args{exec};
830b39c5158Smillert        }
831b39c5158Smillert    }
832b39c5158Smillert    else {
833b39c5158Smillert        $args{source} = $test_prog;
834b39c5158Smillert    }
835b39c5158Smillert
836b39c5158Smillert    if ( defined( my $test_args = $self->test_args ) ) {
837898184e3Ssthen
838898184e3Ssthen        if ( ref($test_args) eq 'HASH' ) {
839898184e3Ssthen
840898184e3Ssthen            # different args for each test
841898184e3Ssthen            if ( exists( $test_args->{ $job->description } ) ) {
842898184e3Ssthen                $test_args = $test_args->{ $job->description };
843898184e3Ssthen            }
844898184e3Ssthen            else {
845898184e3Ssthen                $self->_croak( "TAP::Harness Can't find test_args for "
846898184e3Ssthen                      . $job->description );
847898184e3Ssthen            }
848898184e3Ssthen        }
849898184e3Ssthen
850b39c5158Smillert        $args{test_args} = $test_args;
851b39c5158Smillert    }
852b39c5158Smillert
853b39c5158Smillert    return \%args;
854b39c5158Smillert}
855b39c5158Smillert
856b39c5158Smillert=head3 C<make_parser>
857b39c5158Smillert
858b39c5158SmillertMake a new parser and display formatter session. Typically used and/or
859b39c5158Smillertoverridden in subclasses.
860b39c5158Smillert
861b39c5158Smillert    my ( $parser, $session ) = $harness->make_parser;
862b39c5158Smillert
863b39c5158Smillert=cut
864b39c5158Smillert
865b39c5158Smillertsub make_parser {
866b39c5158Smillert    my ( $self, $job ) = @_;
867b39c5158Smillert
868b39c5158Smillert    my $args = $self->_get_parser_args($job);
869b39c5158Smillert    $self->_make_callback( 'parser_args', $args, $job->as_array_ref );
870b39c5158Smillert    my $parser = $self->_construct( $self->parser_class, $args );
871b39c5158Smillert
872b39c5158Smillert    $self->_make_callback( 'made_parser', $parser, $job->as_array_ref );
873b39c5158Smillert    my $session = $self->formatter->open_test( $job->description, $parser );
874b39c5158Smillert
875b39c5158Smillert    return ( $parser, $session );
876b39c5158Smillert}
877b39c5158Smillert
878b39c5158Smillert=head3 C<finish_parser>
879b39c5158Smillert
880b39c5158SmillertTerminate use of a parser. Typically used and/or overridden in
881b39c5158Smillertsubclasses. The parser isn't destroyed as a result of this.
882b39c5158Smillert
883b39c5158Smillert=cut
884b39c5158Smillert
885b39c5158Smillertsub finish_parser {
886b39c5158Smillert    my ( $self, $parser, $session ) = @_;
887b39c5158Smillert
888b39c5158Smillert    $session->close_test;
889b39c5158Smillert    $self->_close_spool($parser);
890b39c5158Smillert
891b39c5158Smillert    return $parser;
892b39c5158Smillert}
893b39c5158Smillert
894b39c5158Smillertsub _open_spool {
895b39c5158Smillert    my $self = shift;
896b39c5158Smillert    my $test = shift;
897b39c5158Smillert
898b39c5158Smillert    if ( my $spool_dir = $ENV{PERL_TEST_HARNESS_DUMP_TAP} ) {
899b39c5158Smillert
900b39c5158Smillert        my $spool = File::Spec->catfile( $spool_dir, $test );
901b39c5158Smillert
902b39c5158Smillert        # Make the directory
903b39c5158Smillert        my ( $vol, $dir, undef ) = File::Spec->splitpath($spool);
904b39c5158Smillert        my $path = File::Spec->catpath( $vol, $dir, '' );
905b39c5158Smillert        eval { mkpath($path) };
906b39c5158Smillert        $self->_croak($@) if $@;
907b39c5158Smillert
908b39c5158Smillert        my $spool_handle = IO::Handle->new;
909b39c5158Smillert        open( $spool_handle, ">$spool" )
910b39c5158Smillert          or $self->_croak(" Can't write $spool ( $! ) ");
911b39c5158Smillert
912b39c5158Smillert        return $spool_handle;
913b39c5158Smillert    }
914b39c5158Smillert
915b39c5158Smillert    return;
916b39c5158Smillert}
917b39c5158Smillert
918b39c5158Smillertsub _close_spool {
919b39c5158Smillert    my $self = shift;
920b39c5158Smillert    my ($parser) = @_;
921b39c5158Smillert
922b39c5158Smillert    if ( my $spool_handle = $parser->delete_spool ) {
923b39c5158Smillert        close($spool_handle)
924b39c5158Smillert          or $self->_croak(" Error closing TAP spool file( $! ) \n ");
925b39c5158Smillert    }
926b39c5158Smillert
927b39c5158Smillert    return;
928b39c5158Smillert}
929b39c5158Smillert
930b39c5158Smillertsub _croak {
931b39c5158Smillert    my ( $self, $message ) = @_;
932b39c5158Smillert    unless ($message) {
933b39c5158Smillert        $message = $self->_error;
934b39c5158Smillert    }
935b39c5158Smillert    $self->SUPER::_croak($message);
936b39c5158Smillert
937b39c5158Smillert    return;
938b39c5158Smillert}
939b39c5158Smillert
940898184e3Ssthen1;
941898184e3Ssthen
942898184e3Ssthen__END__
943898184e3Ssthen
944898184e3Ssthen##############################################################################
945898184e3Ssthen
946898184e3Ssthen=head1 CONFIGURING
947898184e3Ssthen
948898184e3SsthenC<TAP::Harness> is designed to be easy to configure.
949898184e3Ssthen
950898184e3Ssthen=head2 Plugins
951898184e3Ssthen
952898184e3SsthenC<TAP::Parser> plugins let you change the way TAP is I<input> to and I<output>
953898184e3Ssthenfrom the parser.
954898184e3Ssthen
955898184e3SsthenL<TAP::Parser::SourceHandler>s handle TAP I<input>.  You can configure them
956898184e3Ssthenand load custom handlers using the C<sources> parameter to L</new>.
957898184e3Ssthen
958898184e3SsthenL<TAP::Formatter>s handle TAP I<output>.  You can load custom formatters by
959898184e3Ssthenusing the C<formatter_class> parameter to L</new>.  To configure a formatter,
960898184e3Ssthenyou currently need to instantiate it outside of L<TAP::Harness> and pass it in
961898184e3Ssthenwith the C<formatter> parameter to L</new>.  This I<may> be addressed by adding
962898184e3Ssthena I<formatters> parameter to L</new> in the future.
963898184e3Ssthen
964898184e3Ssthen=head2 C<Module::Build>
965898184e3Ssthen
966898184e3SsthenL<Module::Build> version C<0.30> supports C<TAP::Harness>.
967898184e3Ssthen
968898184e3SsthenTo load C<TAP::Harness> plugins, you'll need to use the C<tap_harness_args>
969898184e3Ssthenparameter to C<new>, typically from your C<Build.PL>.  For example:
970898184e3Ssthen
971898184e3Ssthen  Module::Build->new(
972898184e3Ssthen      module_name        => 'MyApp',
973898184e3Ssthen      test_file_exts     => [qw(.t .tap .txt)],
974898184e3Ssthen      use_tap_harness    => 1,
975898184e3Ssthen      tap_harness_args   => {
976898184e3Ssthen          sources => {
977898184e3Ssthen              MyCustom => {},
978898184e3Ssthen              File => {
979898184e3Ssthen                  extensions => ['.tap', '.txt'],
980898184e3Ssthen              },
981898184e3Ssthen          },
98291f110e0Safresh1          formatter_class => 'TAP::Formatter::HTML',
983898184e3Ssthen      },
984898184e3Ssthen      build_requires     => {
985898184e3Ssthen          'Module::Build' => '0.30',
986898184e3Ssthen          'TAP::Harness'  => '3.18',
987898184e3Ssthen      },
988898184e3Ssthen  )->create_build_script;
989898184e3Ssthen
990898184e3SsthenSee L</new>
991898184e3Ssthen
992898184e3Ssthen=head2 C<ExtUtils::MakeMaker>
993898184e3Ssthen
994898184e3SsthenL<ExtUtils::MakeMaker> does not support L<TAP::Harness> out-of-the-box.
995898184e3Ssthen
996898184e3Ssthen=head2 C<prove>
997898184e3Ssthen
998898184e3SsthenL<prove> supports C<TAP::Harness> plugins, and has a plugin system of its
999898184e3Ssthenown.  See L<prove/FORMATTERS>, L<prove/SOURCE HANDLERS> and L<App::Prove>
1000898184e3Ssthenfor more details.
1001898184e3Ssthen
1002898184e3Ssthen=head1 WRITING PLUGINS
1003898184e3Ssthen
1004898184e3SsthenIf you can't configure C<TAP::Harness> to do what you want, and you can't find
1005898184e3Ssthenan existing plugin, consider writing one.
1006898184e3Ssthen
1007898184e3SsthenThe two primary use cases supported by L<TAP::Harness> for plugins are I<input>
1008898184e3Ssthenand I<output>:
1009898184e3Ssthen
1010898184e3Ssthen=over 2
1011898184e3Ssthen
1012898184e3Ssthen=item Customize how TAP gets into the parser
1013898184e3Ssthen
1014898184e3SsthenTo do this, you can either extend an existing L<TAP::Parser::SourceHandler>,
1015898184e3Ssthenor write your own.  It's a pretty simple API, and they can be loaded and
1016898184e3Ssthenconfigured using the C<sources> parameter to L</new>.
1017898184e3Ssthen
1018898184e3Ssthen=item Customize how TAP results are output from the parser
1019898184e3Ssthen
1020898184e3SsthenTo do this, you can either extend an existing L<TAP::Formatter>, or write your
1021898184e3Ssthenown.  Writing formatters are a bit more involved than writing a
1022898184e3SsthenI<SourceHandler>, as you'll need to understand the L<TAP::Parser> API.  A
1023898184e3Ssthengood place to start is by understanding how L</aggregate_tests> works.
1024898184e3Ssthen
1025898184e3SsthenCustom formatters can be loaded configured using the C<formatter_class>
1026898184e3Ssthenparameter to L</new>.
1027898184e3Ssthen
1028898184e3Ssthen=back
1029898184e3Ssthen
1030898184e3Ssthen=head1 SUBCLASSING
1031898184e3Ssthen
1032898184e3SsthenIf you can't configure C<TAP::Harness> to do exactly what you want, and writing
1033898184e3Ssthena plugin isn't an option, consider extending it.  It is designed to be (mostly)
1034898184e3Sstheneasy to subclass, though the cases when sub-classing is necessary should be few
1035898184e3Ssthenand far between.
1036898184e3Ssthen
1037898184e3Ssthen=head2 Methods
1038898184e3Ssthen
1039898184e3SsthenThe following methods are ones you may wish to override if you want to
1040898184e3Ssthensubclass C<TAP::Harness>.
1041898184e3Ssthen
1042898184e3Ssthen=over 4
1043898184e3Ssthen
1044898184e3Ssthen=item L</new>
1045898184e3Ssthen
1046898184e3Ssthen=item L</runtests>
1047898184e3Ssthen
1048898184e3Ssthen=item L</summary>
1049898184e3Ssthen
1050898184e3Ssthen=back
1051898184e3Ssthen
1052898184e3Ssthen=cut
1053898184e3Ssthen
1054b39c5158Smillert=head1 REPLACING
1055b39c5158Smillert
1056b39c5158SmillertIf you like the C<prove> utility and L<TAP::Parser> but you want your
1057b39c5158Smillertown harness, all you need to do is write one and provide C<new> and
1058b39c5158SmillertC<runtests> methods. Then you can use the C<prove> utility like so:
1059b39c5158Smillert
1060b39c5158Smillert prove --harness My::Test::Harness
1061b39c5158Smillert
1062b39c5158SmillertNote that while C<prove> accepts a list of tests (or things to be
1063b39c5158Smillerttested), C<new> has a fairly rich set of arguments. You'll probably want
1064b39c5158Smillertto read over this code carefully to see how all of them are being used.
1065b39c5158Smillert
1066b39c5158Smillert=head1 SEE ALSO
1067b39c5158Smillert
1068b39c5158SmillertL<Test::Harness>
1069b39c5158Smillert
1070b39c5158Smillert=cut
1071b39c5158Smillert
1072b39c5158Smillert# vim:ts=4:sw=4:et:sta
1073