valgrind update

Message-ID: <21671.1061797917@www38.gmx.net>

p4raw-id: //depot/perl@20872

diff --git a/t/TEST b/t/TEST
index 5f95d00..95869fb 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -184,6 +184,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' ) {
@@ -263,11 +264,12 @@ EOT
        }
        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 --suppressions=perl.supp --leak-check=yes "
                                . "--leak-resolution=high --show-reachable=yes "
-                               . "--num-callers=50 $perl";
+                               . "--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";
@@ -308,16 +310,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;
@@ -365,6 +362,15 @@ 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;
@@ -382,11 +388,7 @@ EOT
                    }
                }
                if ($errors or $leaks) {
-                   if (open(V, ">$test.valgrind")) {
-                       for (@valgrind) {
-                           print V $_;
-                       }
-                       close V;
+                   if (rename $valgrind_log, "$test.valgrind") {
                        $valgrind++;
                    } else {
                        warn "$0: Failed to create '$test.valgrind': $!\n";
@@ -395,6 +397,10 @@ EOT
            } 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";

diff --git a/t/op/magic.t b/t/op/magic.t
index f55630a..74a8d25 100755 (executable)
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -267,14 +267,18 @@ if ($Is_VMS || $Is_Dos || $Is_MacOS) {
     skip("%ENV manipulations fail or aren't safe on $^O") for 1..4;
 }
 else {
-       $PATH = $ENV{PATH};
-       $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
-       $ENV{foo} = "bar";
-       %ENV = ();
-       $ENV{PATH} = $PATH;
-       $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
-       ok ($Is_MSWin32 ? (`set foo 2>NUL` eq "")
-                               : (`echo \$foo` eq "\n") );
+       if ($ENV{PERL_VALGRIND}) {
+           skip("clearing \%ENV is not safe when running under valgrind");
+       } else {
+           $PATH = $ENV{PATH};
+           $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
+           $ENV{foo} = "bar";
+           %ENV = ();
+           $ENV{PATH} = $PATH;
+           $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
+           ok ($Is_MSWin32 ? (`set foo 2>NUL` eq "")
+                           : (`echo \$foo` eq "\n") );
+       }
 
        $ENV{__NoNeSuCh} = "foo";
        $0 = "bar";