X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2FTEST;h=7ce93663a5bf320e00a7075050b26866f7643970;hb=fceebc475db7280476c58dcfb36c7e1cd6795eec;hp=e4aa49b6c37bf3cac5067ffe10c7c6ac61891612;hpb=551405c409d33bc8cd0a20177c4ee21a204d18b5;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/TEST b/t/TEST index e4aa49b..7ce9366 100755 --- a/t/TEST +++ b/t/TEST @@ -14,6 +14,7 @@ $| = 1; # Let tests know they're running in the perl core. Useful for modules # which live dual lives on CPAN. $ENV{PERL_CORE} = 1; +delete $ENV{PERL5LIB}; # remove empty elements due to insertion of empty symbols via "''p1'" syntax @ARGV = grep($_,@ARGV) if $^O eq 'VMS'; @@ -29,8 +30,6 @@ our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0; $::torture = 1 if $1 eq 'torture'; $::with_utf8 = 1 if $1 eq 'utf8'; $::with_utf16 = 1 if $1 eq 'utf16'; - $::bytecompile = 1 if $1 eq 'bytecompile'; - $::compile = 1 if $1 eq 'compile'; $::taintwarn = 1 if $1 eq 'taintwarn'; $ENV{PERL_CORE_MINITEST} = 1 if $1 eq 'minitest'; if ($1 =~ /^deparse(,.+)?$/) { @@ -69,7 +68,7 @@ $ENV{EMXSHELL} = 'sh'; # For OS/2 # Roll your own File::Find! use TestInit; use File::Spec; -use Time::HiRes; +if ($show_elapsed_time) { require Time::HiRes } my $curdir = File::Spec->curdir; my $updir = File::Spec->updir; @@ -106,7 +105,7 @@ sub _populate_hash { } unless (@ARGV) { - foreach my $dir (qw(base comp cmd run io op uni)) { + foreach my $dir (qw(base comp cmd run io op uni mro)) { _find_tests($dir); } _find_tests("lib") unless $::core; @@ -152,6 +151,9 @@ unless (@ARGV) { $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 } my $path = File::Spec->catfile($updir, $t); push @ARGV, $path; @@ -164,25 +166,16 @@ unless (@ARGV) { warn "$0: cannot open $mani: $!\n"; } unless ($::core) { + _find_tests('Module_Pluggable'); _find_tests('pod'); _find_tests('x2p'); _find_tests('japh') if $::torture; } } -# Tests known to cause infinite loops for the perlcc tests. -# %::infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); -%::infinite = (); - if ($::deparse) { _testprogs('deparse', '', @ARGV); } -elsif( $::compile ) { - _testprogs('compile', '', @ARGV); -} -elsif( $::bytecompile ) { - _testprogs('bytecompile', '', @ARGV); -} elsif ($::with_utf16) { for my $e (0, 1) { for my $b (0, 1) { @@ -210,34 +203,18 @@ elsif ($::with_utf16) { } } else { - _testprogs('compile', '', @ARGV) if -e "../testcompile"; _testprogs('perl', '', @ARGV); } sub _testprogs { my ($type, $args, @tests) = @_; - print <<'EOT' if ($type eq 'compile'); ------------------------------------------------------------------------------- -TESTING COMPILER ------------------------------------------------------------------------------- -EOT - print <<'EOT' if ($type eq 'deparse'); ------------------------------------------------------------------------------ TESTING DEPARSER ------------------------------------------------------------------------------ EOT - print <$null &&". - "$perl $testswitch $switch -I../lib $utf8 $test.plc |"; - open(RESULTS,$bytecompile_cmd) - or print "can't byte-compile '$bytecompile_cmd': $!.\n"; - } elsif ($type eq 'perl') { my $perl = $ENV{PERL} || './perl'; my $redir = $^O eq 'VMS' ? '2>&1' : ''; if ($ENV{PERL_VALGRIND}) { - $perl = "valgrind --suppressions=perl.supp --leak-check=yes " - . "--leak-resolution=high --show-reachable=yes " - . "--num-callers=50 --logfile-fd=3 $perl"; + my $valgrind = $ENV{VALGRIND} // 'valgrind'; + my $vg_opts = $ENV{VG_OPTS} + // "--suppressions=perl.supp --leak-check=yes " + . "--leak-resolution=high --show-reachable=yes " + . "--num-callers=50"; + $perl = "$valgrind --log-fd=3 $vg_opts $perl"; $redir = "3>$valgrind_log"; } my $run = "$perl" . _quote_args("$testswitch $switch $utf8") . " $test $redir|"; open(RESULTS,$run) or print "can't run '$run': $!.\n"; } - else { - my $compile_cmd; - my $pl2c = "$testswitch -I../lib ../utils/perlcc --testsuite " . - # -O9 for good measure, -fcog is broken ATM - "$switch -Wb=-O9,-fno-cog -L .. " . - "-I \".. ../lib/CORE\" $args $utf8 $test -o "; - - if( $^O eq 'MSWin32' ) { - $test_executable = "$test.exe"; - # hopefully unused name... - open HACK, "> xweghyz.pl"; - print HACK <) {m/^\\w+\\.[cC]\$/ && next;print} -open HACK, '$test_executable |'; -while() {print} -EOT - close HACK; - $compile_cmd = 'xweghyz.pl |'; - } - else { - $test_executable = "$test.plc"; - $compile_cmd - = "./perl $pl2c $test_executable && $test_executable |"; - } - unlink $test_executable if -f $test_executable; - open(RESULTS, $compile_cmd) - or print "can't compile '$compile_cmd': $!.\n"; - } + # Our environment may force us to use UTF-8, but we can't be sure that + # anything we're reading from will be generating (well formed) UTF-8 + # This may not be the best way - possibly we should unset ${^OPEN} up + # top? + binmode RESULTS; my $failure; my $next = 0; @@ -462,7 +386,7 @@ EOT # SKIP is essentially the same as TODO for t/TEST # this still conforms to TAP: - # http://search.cpan.org/dist/Test-Harness/lib/Test/Harness/TAP.pod + # http://search.cpan.org/dist/TAP/TAP.pod $extra and $istodo = $extra =~ /#\s*(?:TODO|SKIP)\b/; $istodo = 1 if $todo{$num}; @@ -480,6 +404,9 @@ EOT die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n"); } else { + # module tests are allowed extra output, + # because Test::Harness allows it + next if $test =~ /^\W*(ext|lib)\b/; $failure = "FAILED--unexpected output at test $next"; last; } @@ -502,7 +429,14 @@ EOT warn "$0: Failed to open '$valgrind_log': $!\n"; } } - if (@valgrind) { + if ($ENV{VG_OPTS} =~ /cachegrind/) { + if (rename $valgrind_log, "$test.valgrind") { + $valgrind++; + } else { + warn "$0: Failed to create '$test.valgrind': $!\n"; + } + } + elsif (@valgrind) { my $leaks = 0; my $errors = 0; for my $i (0..$#valgrind) { @@ -544,21 +478,23 @@ EOT rename("perl.3log", $tpp) || die "rename: perl3.log to $tpp: $!\n"; } - # test if the compiler compiled something - if( $type eq 'compile' && !-e "$test_executable" ) { - $failure = "Test did not compile"; - } if (not defined $failure and $next != $max) { $failure="FAILED--expected $max tests, saw $next"; } + if( !defined $failure # don't mask a test failure + and $? ) + { + $failure = "FAILED--non-zero wait status: $?"; + } + if (defined $failure) { print "${te}$failure\n"; $::bad_files++; - $_ = $test; - if (/^base/) { - die "Failed a basic test--cannot continue.\n"; + if ($test =~ /^base/) { + die "Failed a basic test ($test) -- cannot continue.\n"; } + ++$failed_tests{$test}; } else { if ($max) { @@ -573,7 +509,7 @@ EOT $good_files++; } else { - print "${te}skipping test on this platform\n"; + print "${te}skipped\n"; $tested_files -= 1; } } @@ -590,11 +526,10 @@ EOT } else { my $pct = $tested_files ? sprintf("%.2f", ($tested_files - $::bad_files) / $tested_files * 100) : "0.00"; - if ($::bad_files == 1) { - warn "Failed 1 test script out of $tested_files, $pct% okay.\n"; - } - else { - warn "Failed $::bad_files test scripts out of $tested_files, $pct% okay.\n"; + my $s = $::bad_files == 1 ? "" : "s"; + warn "Failed $::bad_files test$s out of $tested_files, $pct% okay.\n"; + for my $test ( sort keys %failed_tests ) { + print "\t$test\n"; } warn <<'SHRDLU_1'; ### Since not all tests were successful, you may want to run some of @@ -641,3 +576,5 @@ SHRDLU_5 } } exit ($::bad_files != 0); + +# ex: set ts=8 sts=4 sw=4 noet: