X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fharness;h=f7239fe3b177e055eb261824540ae248383389ca;hb=e568f1a0c324be00c66a63ff9480ccd16934f37e;hp=174b3185762ff83bd66871f372d6121489753903;hpb=56eca212f2b30bfbbee425e020ba96a43f99cca5;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/harness b/t/harness index 174b318..f7239fe 100644 --- a/t/harness +++ b/t/harness @@ -5,34 +5,97 @@ BEGIN { chdir 't' if -d 't'; - unshift @INC, '../lib'; - $ENV{PERL5LIB} = '../lib'; # so children will see it too + @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::switches = ""; # Too much noise otherwise $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v'; -@tests = @ARGV; -@tests = unless @tests; +if ($ARGV[0] eq '-torture') { + shift; + $torture = 1; +} -Test::Harness::runtests @tests; -exit(0) unless -e "../testcompile"; +# Let tests know they're running in the perl core. Useful for modules +# which live dual lives on CPAN. +$ENV{PERL_CORE} = 1; -%infinite = qw( - op/bop.t 1 - lib/hostname.t 1 - ); #fudge DATA for now. %datahandle = qw( lib/bigint.t 1 lib/bigintpm.t 1 lib/bigfloat.t 1 lib/bigfloatpm.t 1 + op/gv.t 1 + lib/complex.t 1 + lib/ph.t 1 + lib/soundex.t 1 + op/misc.t 1 + op/runlevel.t 1 + op/tie.t 1 + op/lex_assign.t 1 ); +foreach (keys %datahandle) { + unlink "$_.t"; +} + +my @tests = (); + +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 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!) { + push @tests, File::Spec->catfile($updir, $1); + } + } + close MANI; + } else { + warn "$0: cannot open $mani: $!\n"; + } + push @tests, ; + push @tests, ; + } +} +if ($^O eq 'MSWin32') { + s,\\,/,g for @tests; +} +Test::Harness::runtests @tests; +exit(0) unless -e "../testcompile"; + +# %infinite = qw ( +# op/bop.t 1 +# lib/hostname.t 1 +# op/lex_assign.t 1 +# lib/ph.t 1 +# ); + my $dhwrapper = <<'EOT'; open DATA,"<".__FILE__; until (($_=) =~ /^__END__/) {}; @@ -40,22 +103,26 @@ EOT @tests = grep (!$infinite{$_}, @tests); @tests = map { - my $new = $_; - if ($datahandle{$_}) { - $new .= '.t'; - local(*F, *T); - open(F,"<$_") or die "Can't open $_: $!"; - open(T,">$new") or die "Can't open $new: $!"; - print T $dhwrapper, ; - close F; - close T; - } - $new; - } @tests; - -print "The tests ", join(' ', keys(%infinite)), - " generate infinite loops! Skipping!\n"; -$ENV{'COMPILE_TEST'} = 1; Test::Harness::runtests @tests; + my $new = $_; + if ($datahandle{$_} && !( -f "$new.t") ) { + $new .= '.t'; + local(*F, *T); + open(F,"<$_") or die "Can't open $_: $!"; + open(T,">$new") or die "Can't open $new: $!"; + print T $dhwrapper, ; + close F; + close T; + } + $new; + } @tests; + +print "The tests ", join(' ', keys(%infinite)), + " generate infinite loops! Skipping!\n"; + +$ENV{'HARNESS_COMPILE_TEST'} = 1; +$ENV{'PERLCC_TIMEOUT'} = 120 unless $ENV{'PERLCC_TIMEOUT'}; + +Test::Harness::runtests @tests; foreach (keys %datahandle) { unlink "$_.t"; }