From: Marcus Holland-Moritz <mhx-perl@gmx.net>
Date: Mon, 25 Aug 2003 09:51:57 +0000 (+0200)
Subject: valgrind update
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=da51b73c5ae244acdcf78affd6c0b7179750d917;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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";