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