[perl #121431] Add support for test.valgrind parallel testing.

Output for each test will be printed inline when it finishes.

Sample usage (loud):

  TEST_JOBS=9 make test.valgrind

Sample usage (quiet):

  VG_OPTS='-q --leak-check=no --show-reachable=no' TEST_JOBS=9 make test.valgrind

3 files changed, 147 insertions, 86 deletions

diff --git a/Makefile.SH b/Makefile.SH
index b24441364a..0fb30e82e6 100755
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -1510,7 +1510,7 @@ test.valgrind check.valgrind:	test_prep
 	@grep "^usemymalloc='n'" config.sh >/dev/null || exit 1
 	@echo "And of course you have to have valgrind..."
 	$(VALGRIND) $(VG_TEST) || exit 1
-	PERL_VALGRIND=1 VALGRIND='$(VALGRIND)' $(RUN_TESTS) choose
+	PERL_VALGRIND=1 VALGRIND='$(VALGRIND)' TESTFILE=harness $(RUN_TESTS) choose
 !NO!SUBS!
 	;;
 esac
diff --git a/t/TEST b/t/TEST
index 96eb6a48dc..ff5d77bdb4 100755
--- a/t/TEST
+++ b/t/TEST
@@ -93,13 +93,23 @@ for my $envname (@bad_env_vars) {
     }
 }
 
+# Location to put the Valgrind log.
+our $Valgrind_Log;
+
+my %skip = (
+	    '.' => 1,
+	    '..' => 1,
+	    'CVS' => 1,
+	    'RCS' => 1,
+	    'SCCS' => 1,
+	    '.svn' => 1,
+	   );
+
+
 if ($::do_nothing) {
     return 1;
 }
 
-# Location to put the Valgrind log.
-our $Valgrind_Log;
-
 $| = 1;
 
 # for testing TEST only
@@ -149,15 +159,6 @@ $ENV{EMXSHELL} = 'sh';        # For OS/2
 if ($show_elapsed_time) { require Time::HiRes }
 my %timings = (); # testname => [@et] pairs if $show_elapsed_time.
 
-my %skip = (
-	    '.' => 1,
-	    '..' => 1,
-	    'CVS' => 1,
-	    'RCS' => 1,
-	    'SCCS' => 1,
-	    '.svn' => 1,
-	   );
-
 # Roll your own File::Find!
 sub _find_tests { our @found=(); push @ARGV, _find_files('\.t$', $_[0]) }
 sub _find_files {
@@ -284,16 +285,19 @@ sub _cmd {
         if ($ENV{PERL_VALGRIND}) {
             my $perl_supp = $options->{return_dir} ? "$options->{return_dir}/perl.supp" : "perl.supp";
             my $valgrind_exe = $ENV{VALGRIND} // 'valgrind';
+            if ($options->{run_dir}) {
+                $Valgrind_Log = "$options->{run_dir}/$Valgrind_Log";
+            }
             my $vg_opts = $ENV{VG_OPTS}
-              // '--log-fd=3 '
+	       //   "--log-file=$Valgrind_Log "
 		  . "--suppressions=$perl_supp --leak-check=yes "
 		  . "--leak-resolution=high --show-reachable=yes "
-                  . "--num-callers=50 --track-origins=yes";
+		  . "--num-callers=50 --track-origins=yes";
+	    # Force logging if not asked for (so cachegrind reporting works below)
+	    if ($vg_opts !~ /--log-file/) {
+		$vg_opts = "--log-file=$Valgrind_Log $vg_opts";
+	    }
             $perl = "$valgrind_exe $vg_opts $perl";
-            $redir = "3>$Valgrind_Log";
-            if ($options->{run_dir}) {
-                $Valgrind_Log = "$options->{run_dir}/$Valgrind_Log";
-            }
         }
 
         my $args = "$options->{testswitch} $options->{switch} $options->{utf8}";
@@ -310,6 +314,16 @@ sub _before_fork {
 	chdir $run_dir or die "Can't chdir to '$run_dir': $!";
     }
 
+    # Remove previous valgrind output otherwise it will interfere
+    my $test = $options->{test};
+
+    (local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
+
+    if ($ENV{PERL_VALGRIND} && -e $Valgrind_Log) {
+        unlink $Valgrind_Log
+            or warn "$0: Failed to unlink '$Valgrind_Log': $!\n";
+    }
+
     return;
 }
 
@@ -553,7 +567,8 @@ EOT
 	    $te = '';
 	}
 
-        (local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
+	(local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
+
 	my $results = _run_test($test, $type);
 
 	my $failure;
@@ -653,62 +668,8 @@ EOT
 	    $failure = 'FAILED--no leader found' unless $seen_leader;
 	}
 
-	if ($ENV{PERL_VALGRIND}) {
-	    $toolnm = $ENV{VALGRIND};
-	    $toolnm =~ s|.*/||;  # keep basename
-	    my @valgrind;	# gets content of file
-	    if (-e $Valgrind_Log) {
-		if (open(V, $Valgrind_Log)) {
-		    @valgrind = <V>;
-		    close V;
-		} else {
-		    warn "$0: Failed to open '$Valgrind_Log': $!\n";
-		}
-	    }
-	    if ($ENV{VG_OPTS} =~ /(cachegrind)/ or $toolnm =~ /(perf)/) {
-		$toolnm = $1;
-		if ($toolnm eq 'perf') {
-		    # append perfs subcommand, not just stat
-		    my ($sub) = split /\s/, $ENV{VG_OPTS};
-		    $toolnm .= "-$sub";
-		}
-		if (rename $Valgrind_Log, "$test.$toolnm") {
-		    $grind_ct++;
-		} else {
-		    warn "$0: Failed to create '$test.$toolnm': $!\n";
-		}
-	    }
-	    elsif (@valgrind) {
-		my $leaks = 0;
-		my $errors = 0;
-		for my $i (0..$#valgrind) {
-		    local $_ = $valgrind[$i];
-		    if (/^==\d+== ERROR SUMMARY: (\d+) errors? /) {
-			$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 = $leaks + $1;
-			    }
-			}
-		    }
-		}
-		if ($errors or $leaks) {
-		    if (rename $Valgrind_Log, "$test.valgrind") {
-			$grind_ct = $grind_ct + 1;
-		    } 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";
-	    }
-	}
+	_check_valgrind(\$toolnm, \$grind_ct, \$test);
+
 	if ($type eq 'deparse') {
 	    unlink "./$test.dp";
 	}
@@ -830,16 +791,8 @@ SHRDLU_5
 	    print "wrote storable file: $fn\n";
 	}
     }
-    if ($ENV{PERL_VALGRIND}) {
-	my $s = $grind_ct == 1 ? '' : 's';
-	print "$grind_ct valgrind report$s created.\n", ;
-	if ($toolnm eq 'cachegrind') {
-	    # cachegrind leaves a lot of cachegrind.out.$pid litter
-	    # around the tree, find and delete them
-	    unlink _find_files('cachegrind.out.\d+$',
-			     qw ( ../t ../cpan ../ext ../dist/ ));
-	}
-    }
+
+    _cleanup_valgrind(\$toolnm, \$grind_ct);
 }
 exit ($::bad_files != 0);
 
@@ -874,4 +827,82 @@ sub gather_conf_platform_info {
 	);
 }
 
+sub _check_valgrind {
+    return unless $ENV{PERL_VALGRIND};
+
+    my ($toolnm, $grind_ct, $test) = @_;
+
+    $$toolnm = $ENV{VALGRIND};
+    $$toolnm =~ s|.*/||;  # keep basename
+    my @valgrind;	# gets content of file
+    if (-e $Valgrind_Log) {
+	if (open(V, $Valgrind_Log)) {
+	    @valgrind = <V>;
+	    close V;
+	} else {
+	    warn "$0: Failed to open '$Valgrind_Log': $!\n";
+	}
+    }
+    if ($ENV{VG_OPTS} =~ /(cachegrind)/ or $$toolnm =~ /(perf)/) {
+	$$toolnm = $1;
+	if ($$toolnm eq 'perf') {
+	    # append perfs subcommand, not just stat
+	    my ($sub) = split /\s/, $ENV{VG_OPTS};
+	    $$toolnm .= "-$sub";
+	}
+	if (rename $Valgrind_Log, "$$test.$$toolnm") {
+	    $$grind_ct++;
+	} else {
+	    warn "$0: Failed to create '$$test.$$toolnm': $!\n";
+	}
+    }
+    elsif (@valgrind) {
+	my $leaks = 0;
+	my $errors = 0;
+	for my $i (0..$#valgrind) {
+	    local $_ = $valgrind[$i];
+	    if (/^==\d+== ERROR SUMMARY: (\d+) errors? /) {
+		$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 = $leaks + $1;
+		    }
+		}
+	    }
+	}
+	if ($errors or $leaks) {
+	    if (rename $Valgrind_Log, "$$test.valgrind") {
+		$$grind_ct = $$grind_ct + 1;
+	    } else {
+		warn "$0: Failed to create '$$test.valgrind': $!\n";
+	    }
+	}
+    } else {
+        # Quiet wasn't asked for? Something may be amiss
+	if ($ENV{VG_OPTS} && $ENV{VG_OPTS} !~ /(^|\s)(-q|--quiet)(\s|$)/) {
+	    warn "No valgrind output?\n";
+	}
+    }
+    if (-e $Valgrind_Log) {
+	unlink $Valgrind_Log
+	    or warn "$0: Failed to unlink '$Valgrind_Log': $!\n";
+    }
+}
+
+sub _cleanup_valgrind {
+    return unless $ENV{PERL_VALGRIND};
+
+    my ($toolnm, $grind_ct) = @_;
+    my $s = $$grind_ct == 1 ? '' : 's';
+    print "$$grind_ct valgrind report$s created.\n", ;
+    if ($$toolnm eq 'cachegrind') {
+	# cachegrind leaves a lot of cachegrind.out.$pid litter
+	# around the tree, find and delete them
+	unlink _find_files('cachegrind.out.\d+$',
+		     qw ( ../t ../cpan ../ext ../dist/ ));
+    }
+}
+
 # ex: set ts=8 sts=4 sw=4 noet:
diff --git a/t/harness b/t/harness
index 1ed70cb1d3..0746e6e280 100644
--- a/t/harness
+++ b/t/harness
@@ -16,10 +16,15 @@ use Config;
 
 $::do_nothing = $::do_nothing = 1;
 require './TEST';
+our $Valgrind_Log;
 
 my $Verbose = 0;
 $Verbose++ while @ARGV && $ARGV[0] eq '-v' && shift;
 
+# For valgrind summary output
+my $htoolnm;
+my $hgrind_ct;
+
 if ($ARGV[0] && $ARGV[0] eq '-torture') {
     shift;
     $torture = 1;
@@ -224,10 +229,34 @@ my $h = TAP::Harness->new({
 	    $options = $options{$test} = _scan_test($test, $type);
 	}
 
+	(local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
+
 	return [ split ' ', _cmd($options, $type) ];
     },
 });
 
+# Print valgrind output after test completes
+if ($ENV{PERL_VALGRIND}) {
+    $h->callback(
+		 after_test => sub {
+		     my ($job) = @_;
+		     my $test = $job->[0];
+		     my $vfile = "$test.valgrind-current";
+	             $vfile =~ s/^.*\///;
+
+		     if ( (! -z $vfile) && open(my $voutput, '<', $vfile)) {
+			print "$test: Valgrind output:\n";
+			print "$test: $_" for <$voutput>;
+			close($voutput);
+		     }
+
+		     (local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
+
+		     _check_valgrind(\$htoolnm, \$hgrind_ct, \$test);
+		 }
+		 );
+}
+
 if ($state) {
     $h->callback(
 		 after_test => sub {
@@ -260,4 +289,5 @@ $h->callback(
 	     );
 
 my $agg = $h->runtests(@tests);
+_cleanup_valgrind(\$htoolnm, \$hgrind_ct);
 exit $agg->has_errors ? 1 : 0;