Re: valgrind as a leak hound?

From: "Marcus Holland-Moritz" <mhx-perl@gmx.net>
Message-ID: <002201c368f4$4e5a5e40$0c2f1fac@R2D2>

Add the leak detection to valgrind testing.

p4raw-id: //depot/perl@20850

2 files changed, 62 insertions, 21 deletions

diff --git a/t/TEST b/t/TEST
index a3ed8f6354..5f95d00740 100755
--- a/t/TEST
+++ b/t/TEST
@@ -112,7 +112,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;
     }
@@ -265,7 +265,9 @@ EOT
 	    my $perl = $ENV{PERL} || './perl';
 	    my $redir = ($^O eq 'VMS' || $ENV{PERL_VALGRIND} ? '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 $perl";
 	    }
 	    my $run = "$perl" . _quote_args("$testswitch $switch $utf") . " $test $redir|";
 	    open(RESULTS,$run) or print "can't run '$run': $!.\n";
@@ -364,30 +366,30 @@ EOT
 	close RESULTS;
 	if ($ENV{PERL_VALGRIND}) {
 	    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 (/^==\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 (defined $errors) {
-		    $errors -= $skip_pthread_mutex_unlock;
-		    if ($errors) {
-			if (open(V, ">$test.valgrind")) {
-			    for (@valgrind) {
-				print V $_;
-			    }
-			    close V;
-			    $valgrind++;
-			} else {
-			    warn "$0: Failed to create '$test.valgrind': $!\n";
+		if ($errors or $leaks) {
+		    if (open(V, ">$test.valgrind")) {
+			for (@valgrind) {
+			    print V $_;
 			}
+			close V;
+			$valgrind++;
+		    } else {
+			warn "$0: Failed to create '$test.valgrind': $!\n";
 		    }
 		}
 	    } else {
diff --git a/t/perl.supp b/t/perl.supp
new file mode 100644
index 0000000000..fb25ea7c5c
--- /dev/null
+++ b/t/perl.supp
@@ -0,0 +1,39 @@
+## Catch various leaks during dlopen...
+{
+   calloc
+   Memcheck:Leak
+   fun:calloc
+   obj:/lib/ld-2.*.so
+}
+{
+   malloc
+   Memcheck:Leak
+   fun:malloc
+   obj:/lib/ld-2.*.so
+}
+{
+   realloc
+   Memcheck:Leak
+   fun:malloc
+   fun:realloc
+   obj:/lib/ld-2.*.so
+}
+{
+   calloc
+   Memcheck:Leak
+   fun:calloc
+   obj:/lib/libdl-2.*.so
+}
+{
+   malloc
+   Memcheck:Leak
+   fun:malloc
+   obj:/lib/libdl-2.*.so
+}
+{
+   realloc
+   Memcheck:Leak
+   fun:malloc
+   fun:realloc
+   obj:/lib/libdl-2.*.so
+}