X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fharness;h=88a7bfad78a799e48d2764a0b9bacc05477a6d8b;hb=3fd969f44926f311e1c67d9470a9e936f7af2d73;hp=662afb64dc6bc6631f1e5c803ccd3ea45cd44a22;hpb=e772598991ca5994af17ccfc75b507c64089f992;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/harness b/t/harness index 662afb6..88a7bfa 100644 --- a/t/harness +++ b/t/harness @@ -7,13 +7,15 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; # pick up only this build's lib } -delete $ENV{PERL5LIB}; my $torture; # torture testing? use TAP::Harness 3.13; use strict; +$::do_nothing = $::do_nothing = 1; +require './TEST'; + my $Verbose = 0; $Verbose++ while @ARGV && $ARGV[0] eq '-v' && shift; @@ -51,10 +53,6 @@ my (@tests, $re); # [.VMS]TEST.COM calls harness with empty arguments, so clean-up @ARGV @ARGV = grep $_ && length( $_ ) => @ARGV; -sub _populate_hash { - return map {$_, 1} split /\s+/, $_[0]; -} - sub _extract_tests; sub _extract_tests { # This can probably be done more tersely with a map, but I doubt that it @@ -103,40 +101,6 @@ if ($ENV{HARNESS_OPTIONS}) { } } -sub _tests_from_manifest { - my ($extensions, $known_extensions) = @_; - my %skip; - my %extensions = _populate_hash($extensions); - my %known_extensions = _populate_hash($known_extensions); - - foreach (keys %known_extensions) { - $skip{$_}++ unless $extensions{$_}; - } - - my @results; - my $mani = '../MANIFEST'; - if (open(MANI, $mani)) { - while () { # similar code in t/TEST - if (m!^(ext/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) { - my ($test, $extension) = ($1, $2); - if (defined $extension) { - $extension =~ s!/t$!!; - # XXX Do I want to warn that I'm skipping these? - next if $skip{$extension}; - my $flat_extension = $extension; - $flat_extension =~ s!-!/!g; - next if $skip{$flat_extension}; # Foo/Bar may live in Foo-Bar - } - push @results, "../$test"; - } - } - close MANI; - } else { - warn "$0: cannot open $mani: $!\n"; - } - return @results; -} - if (@ARGV) { # If you want these run in speed order, just use prove if ($^O eq 'MSWin32') { @@ -163,7 +127,7 @@ if (@ARGV) { unless (@tests) { my @seq = ; - my @next = qw(comp run cmd io op uni mro lib porting); + my @next = qw(comp run cmd io re op uni mro lib porting); push @next, 'japh' if $torture; push @next, 'win32' if $^O eq 'MSWin32'; push @next, 'benchmark' if $ENV{PERL_BENCHMARK}; @@ -196,7 +160,6 @@ if (@ARGV) { use Config; push @last, sort { lc $a cmp lc $b } _tests_from_manifest($Config{extensions}, $Config{known_extensions}); - push @last, ; push @last, ; my %times; @@ -237,11 +200,29 @@ if ($^O eq 'MSWin32') { @tests=grep /$re/, @tests if $re; +my %options; + +my $type = 'perl'; + +# Load TAP::Parser now as otherwise it could be required in the short time span +# in which the harness process chdirs into ext/Dist +require TAP::Parser; + my $h = TAP::Harness->new({ rules => $rules, color => $color, jobs => $jobs, verbosity => $Verbose, + exec => sub { + my ($harness, $test) = @_; + + my $options = $options{$test}; + if (!defined $options) { + $options = $options{$test} = _scan_test($test, $type); + } + + return [ split ' ', _cmd($options, $type) ]; + }, }); if ($state) { @@ -259,9 +240,21 @@ if ($state) { $h->callback( parser_args => sub { - my ( $args, $test ) = @_; - push @{ $args->{switches} }, '-I../lib'; + my ($args, $job) = @_; + my $test = $job->[0]; + _before_fork($options{$test}); + push @{ $args->{switches} }, "-I../../lib"; + } + ); + +$h->callback( + made_parser => sub { + my ($parser, $job) = @_; + my $test = $job->[0]; + my $options = delete $options{$test}; + _after_fork($options); } ); -$h->runtests(@tests); -exit(0); + +my $agg = $h->runtests(@tests); +exit $agg->has_errors ? 1 : 0;