use strict;
use warnings;
-use TAP::Harness;
+use TAP::Harness::Env;
use Text::ParseWords qw(shellwords);
use File::Spec;
use Getopt::Long;
=head1 VERSION
-Version 3.30
+Version 3.31
=cut
-our $VERSION = '3.30';
+our $VERSION = '3.31';
=head1 DESCRIPTION
for my $key (@is_array) {
$self->{$key} = [];
}
- $self->{harness_class} = 'TAP::Harness';
for my $attr (@ATTR) {
if ( exists $args->{$attr} ) {
}
}
- my %env_provides_default = (
- HARNESS_TIMER => 'timer',
- );
-
- while ( my ( $env, $attr ) = each %env_provides_default ) {
- $self->{$attr} = 1 if $ENV{$env};
- }
$self->state_class('App::Prove::State');
return $self;
}
}
$args{rules} = { par => [@rules] };
}
+ $args{harness_class} = $self->{harness_class} if $self->{harness_class};
- return ( \%args, $self->{harness_class} );
+ return \%args;
}
sub _find_module {
}
sub _runtests {
- my ( $self, $args, $harness_class, @tests ) = @_;
- my $harness = $harness_class->new($args);
+ my ( $self, $args, @tests ) = @_;
+ my $harness = TAP::Harness::Env->create($args);
my $state = $self->state_manager;
push @switches, '-w';
}
- push @switches, shellwords( $ENV{HARNESS_PERL_SWITCHES} ) if defined $ENV{HARNESS_PERL_SWITCHES};
-
return @switches ? \@switches : ();
}
=head1 VERSION
-Version 3.30
+Version 3.31
=cut
-our $VERSION = '3.30';
+our $VERSION = '3.31';
$ENV{HARNESS_ACTIVE} = 1;
$ENV{HARNESS_VERSION} = $VERSION;
test_args => sub { shift; shift },
ignore_exit => sub { shift; shift },
rules => sub { shift; shift },
+ rulesfile => sub { shift; shift },
sources => sub { shift; shift },
version => sub { shift; shift },
trap => sub { shift; shift },
=item * C<rules>
A reference to a hash of rules that control which tests may be executed in
-parallel. If no rules are declared, all tests are eligible for being run in
-parallel. Here some simple examples. For the full details of the data structure
+parallel. If no rules are declared and L<CPAN::Meta::YAML> is available,
+C<TAP::Harness> attempts to load rules from a YAML file specified by the
+C<rulesfile> parameter. If no rules file exists, the default is for all
+tests to be eligible to be run in parallel.
+
+Here some simple examples. For the full details of the data structure
and the related glob-style pattern matching, see
L<TAP::Parser::Scheduler/"Rules data structure">.
par => 't/p*.t'
});
+ # Equivalent YAML file
+ ---
+ par: t/p*.t
+
# Run all tests in parallel, except those starting with "p"
$harness->rules({
seq => [
],
});
+ # Equivalent YAML file
+ ---
+ seq:
+ - seq: t/p*.t
+ - par: **
+
# Run some startup tests in sequence, then some parallel tests than some
# teardown tests in sequence.
$harness->rules({
});
+ # Equivalent YAML file
+ ---
+ seq:
+ - seq: t/startup/*.t
+ - par:
+ - t/a/*.t
+ - t/b/*.t
+ - t/c/*.t
+ - seq: t/shutdown/*.t
+
This is an experimental feature and the interface may change.
+=item * C<rulesfiles>
+
+This specifies where to find a YAML file of test scheduling rules. If not
+provided, it looks for a default file to use. It first checks for a file given
+in the C<HARNESS_RULESFILE> environment variable, then it checks for
+F<testrules.yml> and then F<t/testrules.yml>.
+
=item * C<stdout>
A filehandle for catching standard output.
$self->jobs(1) unless defined $self->jobs;
+ if ( ! defined $self->rules ) {
+ $self->_maybe_load_rulesfile;
+ }
+
local $default_class{formatter_class} = 'TAP::Formatter::File'
unless -t ( $arg_for{stdout} || \*STDOUT ) && !$ENV{HARNESS_NOTTY};
return $self;
}
+
+ sub _maybe_load_rulesfile {
+ my ($self) = @_;
+
+ my ($rulesfile) = defined $self->rulesfile ? $self->rulesfile :
+ defined($ENV{HARNESS_RULESFILE}) ? $ENV{HARNESS_RULESFILE} :
+ grep { -r } qw(./testrules.yml t/testrules.yml);
+
+ if ( defined $rulesfile && -r $rulesfile ) {
+ if ( ! eval { require CPAN::Meta::YAML; 1} ) {
+ warn "CPAN::Meta::YAML required to process $rulesfile" ;
+ return;
+ }
+ my $layer = $] lt "5.008" ? "" : ":encoding(UTF-8)";
+ open my $fh, "<$layer", $rulesfile
+ or die "Couldn't open $rulesfile: $!";
+ my $yaml_text = do { local $/; <$fh> };
+ my $yaml = CPAN::Meta::YAML->read_string($yaml_text)
+ or die CPAN::Meta::YAML->errstr;
+ $self->rules( $yaml->[0] );
+ }
+ return;
+ }
}
##############################################################################
https://perl5.git.perl.org / perl5.git / commitdiff