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

[perl5.git] / t / TEST

diff --git a/t/TEST b/t/TEST
index ecd5122..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;
     }
@@ -183,6 +186,8 @@ 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' ) {
@@ -197,7 +202,7 @@ EOT
                # Redefinition happens at compile time
                next;
            }
-           elsif ($test eq "lib/switch.t") {
+           elsif ($test =~ m{lib/Switch/t/}) {
                # B::Deparse doesn't support source filtering
                next;
            }
@@ -218,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
@@ -244,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,"
@@ -255,14 +274,20 @@ 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' ? '2>&1' : '');
+           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";
+               $redir = "3>$valgrind_log";
+           }
            my $run = "$perl" . _quote_args("$testswitch $switch $utf") . " $test $redir|";
            open(RESULTS,$run) or print "can't run '$run': $!.\n";
        }
@@ -330,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 ) {
@@ -353,6 +378,47 @@ 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 $leaks = 0;
+               my $errors = 0;
+               for my $i (0..$#valgrind) {
+                   local $_ = $valgrind[$i];
+                   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;
+                           }
+                       }
+                   }
+               }
+               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";
        }
@@ -382,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/) {
@@ -447,5 +514,9 @@ SHRDLU_5
     ($user,$sys,$cuser,$csys) = times;
     print sprintf("u=%g  s=%g  cu=%g  cs=%g  scripts=%d  tests=%d\n",
        $user,$sys,$cuser,$csys,$files,$totmax);
+    if ($ENV{PERL_VALGRIND}) {
+       my $s = $valgrind == 1 ? '' : 's';
+       print "$valgrind valgrind report$s created.\n", ;
+    }
 }
 exit ($bad != 0);