Remove the "malloc wrappage" tests, due to their unportability

[perl5.git] / t / TEST

diff --git a/t/TEST b/t/TEST
index ef98c27..7b9afa6 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -21,8 +21,10 @@ if ($#ARGV >= 0) {
        $verbose = 1 if $1 eq 'v';
        $torture = 1 if $1 eq 'torture';
        $with_utf= 1 if $1 eq 'utf8';
-        $bytecompile = 1 if $1 eq 'bytecompile';
-        $compile = 1 if $1 eq 'compile';
+       $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(,.+)?$/) {
            $deparse = 1;
            $deparse_opts = $1;
@@ -64,9 +66,10 @@ my $updir  = File::Spec->updir;
 
 sub _find_tests {
     my($dir) = @_;
-    opendir DIR, $dir || die "Trouble opening $dir: $!";
+    opendir DIR, $dir or die "Trouble opening $dir: $!";
     foreach my $f (sort { $a cmp $b } readdir DIR) {
-        next if $f eq $curdir or $f eq $updir;
+        next if $f eq $curdir or $f eq $updir or
+           $f =~ /^(?:CVS|RCS|SCCS|\.svn)$/;
 
         my $fullpath = File::Spec->catfile($dir, $f);
 
@@ -112,7 +115,7 @@ unless (@ARGV) {
         warn "$0: cannot open $mani: $!\n";
     }
     unless ($core) {
-       _find_tests('pod');  
+       _find_tests('pod');
        _find_tests('x2p');
        _find_tests('japh') if $torture;
     }
@@ -184,6 +187,7 @@ EOT
     # + 3 : we want three dots between the test name and the "ok"
     $dotdotdot = $maxlen + 3 ;
     my $valgrind = 0;
+    my $valgrind_log = 'current.valgrind';
     while ($test = shift @tests) {
 
        if ( $infinite{$test} && $type eq 'compile' ) {
@@ -219,7 +223,13 @@ EOT
            $switch = qq{"-$1"};
        }
        else {
-           $switch = '';
+           if ($taintwarn) {
+               # not all tests are expected to pass with this option
+               $switch = '"-t"';
+           }
+           else {
+               $switch = '';
+           }
        }
 
         my $test_executable; # for 'compile' tests
@@ -245,9 +255,17 @@ EOT
                or print "can't deparse '$deparse': $!.\n";
        }
        elsif ($type eq 'bytecompile') {
-           my $perl = $ENV{PERL} || './perl';
-           my $redir = ($^O eq 'VMS' ? '2>&1' : '');
-           my $bswitch = "-MO=Bytecode,-H,-TI,-s`pwd`/$test,";
+           my ($pwd, $null);
+            if( $^O eq 'MSWin32') {
+               $pwd = `cd`;
+               $null = 'nul';
+           } else {
+               $pwd = `pwd`;
+               $null = '/dev/null';
+           }
+           chomp $pwd;
+           my $perl = $ENV{PERL} || "$pwd/perl";
+           my $bswitch = "-MO=Bytecode,-H,-TI,-s$pwd/$test,";
            $bswitch .= "-TF$test.plc,"
                if $test =~ m(chdir|pod/|CGI/t/carp|lib/DB);
            $bswitch .= "-k,"
@@ -256,16 +274,19 @@ EOT
                if $test =~ m(op/getpid);
            my $bytecompile =
                "$perl $testswitch $switch -I../lib $bswitch". 
-               "-o$test.plc $test 2>/dev/null &&".
-               "$perl $testswitch $switch -I../lib $utf $test.plc $redir|";
+               "-o$test.plc $test 2>$null &&".
+               "$perl $testswitch $switch -I../lib $utf $test.plc |";
            open(RESULTS,$bytecompile)
                or print "can't byte-compile '$bytecompile': $!.\n";
        }
        elsif ($type eq 'perl') {
            my $perl = $ENV{PERL} || './perl';
-           my $redir = ($^O eq 'VMS' || $ENV{PERL_VALGRIND} ? '2>&1' : '');
+           my $redir = $^O eq 'VMS' ? '2>&1' : '';
            if ($ENV{PERL_VALGRIND}) {
-               $perl = "valgrind --num-callers=50 --leak-check=yes $perl";
+               $perl = "valgrind --suppressions=perl.supp --leak-check=yes "
+                               . "--leak-resolution=high --show-reachable=yes "
+                               . "--num-callers=50 --logfile-fd=3 $perl";
+               $redir = "3>$valgrind_log";
            }
            my $run = "$perl" . _quote_args("$testswitch $switch $utf") . " $test $redir|";
            open(RESULTS,$run) or print "can't run '$run': $!.\n";
@@ -306,16 +327,11 @@ EOT
         $next = 0;
         my $seen_leader = 0;
         my $seen_ok = 0;
-       my @valgrind;
        while (<RESULTS>) {
            next if /^\s*$/; # skip blank lines
            if ($verbose) {
                print $_;
            }
-           if ($ENV{PERL_VALGRIND} && /^==\d+== /) {
-               push @valgrind, $_;
-               next;
-           }
            unless (/^\#/) {
                if (/^1\.\.([0-9]+)( todo ([\d ]+))?/) {
                    $max = $1;
@@ -339,7 +355,7 @@ EOT
                        $seen_ok = 1;
                        if ($2 == $next) {
                            my($not, $num, $extra) = ($1, $2, $3);
-                           my($istodo) = $extra =~ /^\s*#\s*TODO/ if $extra;
+                           my($istodo) = $extra =~ /#\s*TODO/ if $extra;
                            $istodo = 1 if $todo{$num};
 
                            if( $not && !$istodo ) {
@@ -363,36 +379,45 @@ EOT
        }
        close RESULTS;
        if ($ENV{PERL_VALGRIND}) {
+           my @valgrind;
+           if (-e $valgrind_log) {
+               if (open(V, $valgrind_log)) {
+                   @valgrind = <V>;
+                   close V;
+               } else {
+                   warn "$0: Failed to open '$valgrind_log': $!\n";
+               }
+           }
            if (@valgrind) {
-               my $skip_pthread_mutex_unlock;
+               my $leaks = 0;
+               my $errors = 0;
                for my $i (0..$#valgrind) {
                    local $_ = $valgrind[$i];
-                   my $pid;
-                   if (/^==(\d+)== pthread_mutex_unlock: mutex is not locked/ &&
-                       ($pid = $1) &&
-                       $valgrind[$i+2] =~ m{\(in .+/libc.+\.so\)}) {
-                       $skip_pthread_mutex_unlock++;
-                   } elsif (/^==\d+== ERROR SUMMARY: (\d+) errors? /) {
-                       $errors = $1;
-                   }
-               }
-               if (defined $errors) {
-                   $errors -= $skip_pthread_mutex_unlock;
-                   if ($errors) {
-                       if (open(V, ">$test.valgrind")) {
-                           for (@valgrind) {
-                               print V $_;
+                   if (/^==\d+== ERROR SUMMARY: (\d+) 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;
                            }
-                           close V;
-                           $valgrind++;
-                       } else {
-                           warn "$0: Failed to create '$test.valgrind': $!\n";
                        }
                    }
                }
+               if ($errors or $leaks) {
+                   if (rename $valgrind_log, "$test.valgrind") {
+                       $valgrind++;
+                   } else {
+                       warn "$0: Failed to create '$test.valgrind': $!\n";
+                   }
+               }
            } else {
                warn "No valgrind output?\n";
            }
+           if (-e $valgrind_log) {
+               unlink $valgrind_log
+                   or warn "$0: Failed to unlink '$valgrind_log': $!\n";
+           }
        }
        if ($type eq 'deparse') {
            unlink "./$test.dp";
@@ -423,7 +448,8 @@ EOT
        }
        else {
            $next += 1;
-           print "${te}FAILED at test $next\n";
+           print "${te}FAILED at test $next";
+           print ($next > $max) ? "\tpossibly due to extra output\n" : "\n";
            $bad = $bad + 1;
            $_ = $test;
            if (/^base/) {