valgrind update

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

p4raw-id: //depot/perl@20872

1 files changed, 18 insertions, 12 deletions

diff --git a/t/TEST b/t/TEST
index 5f95d00740..95869fbb48 100755
--- 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";