X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/92d4c6331040f899673234f65d5ab2a406c5a32d..d632d9afe2fe0ca4acebe9e4db95ef6ec14a299d:/t/TEST diff --git a/t/TEST b/t/TEST index 520f79b..0c24c17 100755 --- a/t/TEST +++ b/t/TEST @@ -23,39 +23,81 @@ my %dir_to_switch = '../ext/File-Glob/t' => '-I.. -MTestInit', # FIXME - tests assume t/ ); -# I think in the end I'd like "not absolute" to be the default", as it saves -# some fakery within TestInit which can peturb tests, and takes CPU. -my %no_abs = - ('../ext/Pod-Parser' => 1, - ); - +# "not absolute" is the the default, as it saves some fakery within TestInit +# which can peturb tests, and takes CPU. Working with the upstream author of +# any of these, to figure out how to remove them from this list, considered +# "a good thing". +my %abs = ( + '../cpan/Archive-Extract' => 1, + '../cpan/Archive-Tar' => 1, + '../cpan/AutoLoader' => 1, + '../cpan/CPAN' => 1, + '../cpan/Class-ISA' => 1, + '../cpan/Devel-PPPort' => 1, + '../cpan/Encode' => 1, + '../cpan/ExtUtils-Constant' => 1, + '../cpan/ExtUtils-MakeMaker' => 1, + '../cpan/File-Fetch' => 1, + '../cpan/IPC-Cmd' => 1, + '../cpan/IPC-SysV' => 1, + '../cpan/Locale-Codes' => 1, + '../cpan/Log-Message' => 1, + '../cpan/Module-Build' => 1, + '../cpan/Module-Load' => 1, + '../cpan/Module-Load-Conditional' => 1, + '../cpan/Object-Accessor' => 1, + '../cpan/Package-Constants' => 1, + '../cpan/Parse-CPAN-Meta' => 1, + '../cpan/Pod-Simple' => 1, + '../cpan/Term-UI' => 1, + '../cpan/Test-Simple' => 1, + '../cpan/Tie-File' => 1, + '../cpan/podlators' => 1, + '../dist/Cwd' => 1, + '../dist/ExtUtils-Command' => 1, + '../dist/ExtUtils-Install' => 1, + '../dist/ExtUtils-Manifest' => 1, + '../dist/ExtUtils-ParseXS' => 1, + ); + my %temp_no_core = - ('../ext/B-Debug' => 1, - '../ext/Compress-Raw-Bzip2' => 1, - '../ext/Compress-Raw-Zlib' => 1, - '../ext/Devel-PPPort' => 1, - '../ext/Getopt-Long' => 1, - '../ext/IO-Compress' => 1, - '../ext/IPC-SysV' => 1, - '../ext/Math-BigInt' => 1, - '../ext/Math-BigRat' => 1, - '../ext/MIME-Base64' => 1, - '../ext/NEXT' => 1, - '../ext/parent' => 1, - '../ext/Pod-Simple' => 1, - '../ext/Parse-CPAN-Meta' => 1, - '../ext/Tie-RefHash' => 1, - '../ext/Time-HiRes' => 1, - '../ext/Unicode-Normalize' => 1, - '../ext/podlators' => 1, + ('../cpan/B-Debug' => 1, + '../cpan/Compress-Raw-Bzip2' => 1, + '../cpan/Compress-Raw-Zlib' => 1, + '../cpan/Devel-PPPort' => 1, + '../cpan/Getopt-Long' => 1, + '../cpan/IO-Compress' => 1, + '../cpan/MIME-Base64' => 1, + '../cpan/parent' => 1, + '../cpan/Parse-CPAN-Meta' => 1, + '../cpan/Pod-Simple' => 1, + '../cpan/podlators' => 1, + '../cpan/Test-Simple' => 1, + '../cpan/Tie-RefHash' => 1, + '../cpan/Unicode-Collate' => 1, + '../cpan/Unicode-Normalize' => 1, ); +# delete env vars that may influence the results +# but allow override via *_TEST env var if wanted +# (e.g. PERL5OPT_TEST=-d:NYTProf) +for my $envname (qw(PERL5LIB PERLLIB PERL5OPT)) { + my $override = $ENV{"${envname}_TEST"}; + if (defined $override) { + warn "$0: $envname=$override\n"; + $ENV{$envname} = $override; + } + else { + delete $ENV{$envname}; + } +} + if ($::do_nothing) { return 1; } # Location to put the Valgrind log. -my $Valgrind_Log = 'current.valgrind'; +our $Valgrind_Log; $| = 1; @@ -63,10 +105,6 @@ $| = 1; #BEGIN { require '../lib/strict.pm'; "strict"->import() }; #BEGIN { require '../lib/warnings.pm'; "warnings"->import() }; -delete $ENV{PERL5LIB}; -delete $ENV{PERLLIB}; -delete $ENV{PERL5OPT}; - # remove empty elements due to insertion of empty symbols via "''p1'" syntax @ARGV = grep($_,@ARGV) if $^O eq 'VMS'; our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0; @@ -84,7 +122,6 @@ our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0; $::with_utf8 = 1 if $1 eq 'utf8'; $::with_utf16 = 1 if $1 eq 'utf16'; $::taintwarn = 1 if $1 eq 'taintwarn'; - $ENV{PERL_CORE_MINITEST} = 1 if $1 eq 'minitest'; if ($1 =~ /^deparse(,.+)?$/) { $::deparse = 1; $::deparse_opts = $1; @@ -176,7 +213,7 @@ sub _scan_test { if ($type eq 'deparse') { # Look for #line directives which change the filename while (<$script>) { - $file_opts .= ",-f$3$4" + $file_opts = $file_opts . ",-f$3$4" if /^#\s*line\s+(\d+)\s+((\w+)|"([^"]+)")/; } } @@ -192,24 +229,28 @@ sub _scan_test { my $dir = $1; my $testswitch = $dir_to_switch{$dir}; if (!defined $testswitch) { - if ($test =~ s!^(\.\./ext/[^/]+)/t!t!) { + if ($test =~ s!^(\.\./(cpan|dist|ext)/[^/]+)/t!t!) { $run_dir = $1; $return_dir = '../../t'; $lib = '../../lib'; $perl = '../../t/perl'; $testswitch = "-I../.. -MTestInit=U2T"; - if (!$no_abs{$run_dir}) { - $testswitch = $testswitch . ',A'; - } - if ($temp_no_core{$run_dir}) { - $testswitch = $testswitch . ',NC'; + if ($2 eq 'cpan' || $2 eq 'dist') { + if($abs{$run_dir}) { + $testswitch = $testswitch . ',A'; + } + if ($temp_no_core{$run_dir}) { + $testswitch = $testswitch . ',NC'; + } } + } elsif ($test =~ m!^\.\./lib!) { + $testswitch = '-I.. -MTestInit=U1'; # -T will remove . from @INC } else { $testswitch = '-I.. -MTestInit'; # -T will remove . from @INC } } - my $utf8 = $::with_utf8 ? "-I$lib -Mutf8" : ''; + my $utf8 = ($::with_utf8 || $::with_utf16) ? "-I$lib -Mutf8" : ''; my %options = ( perl => $perl, @@ -248,13 +289,17 @@ sub _cmd { my $redir = $^O eq 'VMS' ? '2>&1' : ''; if ($ENV{PERL_VALGRIND}) { + my $perl_supp = $options->{return_dir} ? "$options->{return_dir}/perl.supp" : "perl.supp"; my $valgrind = $ENV{VALGRIND} // 'valgrind'; my $vg_opts = $ENV{VG_OPTS} - // "--suppressions=perl.supp --leak-check=yes " + // "--suppressions=$perl_supp --leak-check=yes " . "--leak-resolution=high --show-reachable=yes " - . "--num-callers=50"; + . "--num-callers=50 --track-origins=yes"; $perl = "$valgrind --log-fd=3 $vg_opts $perl"; $redir = "3>$Valgrind_Log"; + if ($options->{run_dir}) { + $Valgrind_Log = "$options->{run_dir}/$Valgrind_Log"; + } } my $args = "$options->{testswitch} $options->{switch} $options->{utf8}"; @@ -319,7 +364,7 @@ sub _quote_args { # In VMS protect with doublequotes because otherwise # DCL will lowercase -- unless already doublequoted. $_ = q(").$_.q(") if ($^O eq 'VMS') && !/^\"/ && length($_) > 0; - $argstring .= ' ' . $_; + $argstring = $argstring . ' ' . $_; } return $argstring; } @@ -336,19 +381,19 @@ sub _tests_from_manifest { my %known_extensions = _populate_hash($known_extensions); foreach (keys %known_extensions) { - $skip{$_}++ unless $extensions{$_}; + $skip{$_} = 1 unless $extensions{$_}; } my @results; my $mani = '../MANIFEST'; if (open(MANI, $mani)) { while () { - if (m!^(ext/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) { + if (m!^((?:cpan|dist|ext)/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) { my $t = $1; my $extension = $2; if (!$::core || $t =~ m!^lib/[a-z]!) { if (defined $extension) { - $extension =~ s!/t$!!; + $extension =~ s!/t(:?/\S+)*$!!; # XXX Do I want to warn that I'm skipping these? next if $skip{$extension}; my $flat_extension = $extension; @@ -405,7 +450,6 @@ unless (@ARGV) { # something is that badly wrong. push @ARGV, _tests_from_manifest($extensions, $known_extensions); unless ($::core) { - _find_tests('pod'); _find_tests('x2p'); _find_tests('porting'); _find_tests('japh') if $::torture; @@ -502,6 +546,7 @@ EOT $te = ''; } + (local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///; my $results = _run_test($test, $type); my $failure; @@ -537,8 +582,8 @@ EOT } $max = $1; %todo = map { $_ => 1 } split / /, $3 if $3; - $totmax += $max; - $tested_files++; + $totmax = $totmax + $max; + $tested_files = $tested_files + 1; if ($seen_ok) { # 1..n appears at end of file $trailing_leader = 1; @@ -560,7 +605,7 @@ EOT } } $seen_ok = 1; - $next++; + $next = $next + 1; my($not, $num, $extra, $istodo) = ($1, $2, $3, 0); $num = $next unless $num; @@ -568,7 +613,7 @@ EOT # SKIP is essentially the same as TODO for t/TEST # this still conforms to TAP: - # http://search.cpan.org/dist/TAP/TAP.pod + # http://testanything.org/wiki/index.php/TAP_specification $extra and $istodo = $extra =~ /#\s*(?:TODO|SKIP)\b/; $istodo = 1 if $todo{$num}; @@ -588,7 +633,7 @@ EOT else { # module tests are allowed extra output, # because Test::Harness allows it - next if $test =~ /^\W*(ext|lib)\b/; + next if $test =~ /^\W*(cpan|dist|ext|lib)\b/; $failure = "FAILED--unexpected output at test $next"; last; } @@ -613,7 +658,7 @@ EOT } if ($ENV{VG_OPTS} =~ /cachegrind/) { if (rename $Valgrind_Log, "$test.valgrind") { - $valgrind++; + $valgrind = $valgrind + 1; } else { warn "$0: Failed to create '$test.valgrind': $!\n"; } @@ -624,19 +669,19 @@ EOT for my $i (0..$#valgrind) { local $_ = $valgrind[$i]; if (/^==\d+== ERROR SUMMARY: (\d+) errors? /) { - $errors += $1; # there may be multiple error summaries + $errors = $errors + $1; # there may be multiple error summaries } elsif (/^==\d+== LEAK SUMMARY:/) { for my $off (1 .. 4) { if ($valgrind[$i+$off] =~ /(?:lost|reachable):\s+\d+ bytes in (\d+) blocks/) { - $leaks += $1; + $leaks = $leaks + $1; } } } } if ($errors or $leaks) { if (rename $Valgrind_Log, "$test.valgrind") { - $valgrind++; + $valgrind = $valgrind + 1; } else { warn "$0: Failed to create '$test.valgrind': $!\n"; } @@ -672,11 +717,11 @@ EOT if (defined $failure) { print "${te}$failure\n"; - $::bad_files++; + $::bad_files = $::bad_files + 1; if ($test =~ /^base/) { die "Failed a basic test ($test) -- cannot continue.\n"; } - ++$failed_tests{$test}; + $failed_tests{$test} = 1; } else { if ($max) { @@ -688,11 +733,11 @@ EOT $elapsed = ""; } print "${te}ok$elapsed\n"; - $good_files++; + $good_files = $good_files + 1; } else { print "${te}skipped\n"; - $tested_files -= 1; + $tested_files = $tested_files - 1; } } } # while tests