X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fharness;h=b5e3e872f1b1126fb1014e82ba8d67f082385bfc;hb=02bc0c09b2a02ba62249521fe20a53b8d033c440;hp=ca8a676aea2ecb8876cb5eabaebe99db72c55c23;hpb=595ae48196d4b0901d4a1aee37333fa960a6031f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/harness b/t/harness index ca8a676..b5e3e87 100644 --- a/t/harness +++ b/t/harness @@ -5,16 +5,26 @@ BEGIN { chdir 't' if -d 't'; - unshift @INC, '../lib'; + @INC = '../lib'; # pick up only this build's lib $ENV{PERL5LIB} = '../lib'; # so children will see it too } -use lib '../lib'; + +my $torture; # torture testing? use Test::Harness; $Test::Harness::switches = ""; # Too much noise otherwise $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v'; +if ($ARGV[0] && $ARGV[0] eq '-torture') { + shift; + $torture = 1; +} + +# Let tests know they're running in the perl core. Useful for modules +# which live dual lives on CPAN. +$ENV{PERL_CORE} = 1; + #fudge DATA for now. %datahandle = qw( lib/bigint.t 1 @@ -29,16 +39,87 @@ $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v'; op/runlevel.t 1 op/tie.t 1 op/lex_assign.t 1 - pragma/subs.t 1 ); foreach (keys %datahandle) { unlink "$_.t"; } -@tests = @ARGV; -@tests = unless @tests; +my @tests = (); + +# [.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]; +} + +if ($ARGV[0] && $ARGV[0]=~/^-re/) { + if ($ARGV[0]!~/=/) { + shift; + $re=join "|",@ARGV; + @ARGV=(); + } else { + (undef,$re)=split/=/,shift; + } +} + +if (@ARGV) { + if ($^O eq 'MSWin32') { + @tests = map(glob($_),@ARGV); + } + else { + @tests = @ARGV; + } +} else { + unless (@tests) { + push @tests, ; + push @tests, ; + push @tests, ; + push @tests, ; + push @tests, ; + push @tests, ; + push @tests, ; + push @tests, ; + push @tests, if $torture; + push @tests, if $^O eq 'MSWin32'; + use Config; + my %skip; + { + my %extensions = _populate_hash $Config{'extensions'}; + my %known_extensions = _populate_hash $Config{'known_extensions'}; + foreach (keys %known_extensions) { + $skip{$_}++ unless $extensions{$_}; + } + } + use File::Spec; + my $updir = File::Spec->updir; + my $mani = File::Spec->catfile(File::Spec->updir, "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}; + } + push @tests, File::Spec->catfile($updir, $test); + } + } + close MANI; + } else { + warn "$0: cannot open $mani: $!\n"; + } + push @tests, ; + push @tests, ; + } +} +if ($^O eq 'MSWin32') { + s,\\,/,g for @tests; +} +@tests=grep /$re/, @tests + if $re; Test::Harness::runtests @tests; exit(0) unless -e "../testcompile";