Skip to content

Commit be075ca

Browse files
wolfsagewolfsage
committed
[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
1 parent 24e7ff4 commit be075ca

File tree

3 files changed

+147
-86
lines changed

3 files changed

+147
-86
lines changed

‎Makefile.SH

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1510,7 +1510,7 @@ test.valgrind check.valgrind: test_prep
15101510
@grep "^usemymalloc='n'" config.sh >/dev/null || exit 1
15111511
@echo "And of course you have to have valgrind..."
15121512
$(VALGRIND) $(VG_TEST) || exit 1
1513-
PERL_VALGRIND=1 VALGRIND='$(VALGRIND)' $(RUN_TESTS) choose
1513+
PERL_VALGRIND=1 VALGRIND='$(VALGRIND)' TESTFILE=harness $(RUN_TESTS) choose
15141514
!NO!SUBS!
15151515
;;
15161516
esac

‎t/TEST

Lines changed: 116 additions & 85 deletions
Original file line numberDiff line numberDiff line change
@@ -93,13 +93,23 @@ for my $envname (@bad_env_vars) {
9393
}
9494
}
9595

96+
# Location to put the Valgrind log.
97+
our $Valgrind_Log;
98+
99+
my %skip = (
100+
'.' => 1,
101+
'..' => 1,
102+
'CVS' => 1,
103+
'RCS' => 1,
104+
'SCCS' => 1,
105+
'.svn' => 1,
106+
);
107+
108+
96109
if ($::do_nothing) {
97110
return 1;
98111
}
99112

100-
# Location to put the Valgrind log.
101-
our $Valgrind_Log;
102-
103113
$| = 1;
104114

105115
# for testing TEST only
@@ -149,15 +159,6 @@ $ENV{EMXSHELL} = 'sh'; # For OS/2
149159
if ($show_elapsed_time) { require Time::HiRes }
150160
my %timings = (); # testname => [@et] pairs if $show_elapsed_time.
151161

152-
my %skip = (
153-
'.' => 1,
154-
'..' => 1,
155-
'CVS' => 1,
156-
'RCS' => 1,
157-
'SCCS' => 1,
158-
'.svn' => 1,
159-
);
160-
161162
# Roll your own File::Find!
162163
sub _find_tests { our @found=(); push @ARGV, _find_files('\.t$', $_[0]) }
163164
sub _find_files {
@@ -284,16 +285,19 @@ sub _cmd {
284285
if ($ENV{PERL_VALGRIND}) {
285286
my $perl_supp = $options->{return_dir} ? "$options->{return_dir}/perl.supp" : "perl.supp";
286287
my $valgrind_exe = $ENV{VALGRIND} // 'valgrind';
288+
if ($options->{run_dir}) {
289+
$Valgrind_Log = "$options->{run_dir}/$Valgrind_Log";
290+
}
287291
my $vg_opts = $ENV{VG_OPTS}
288-
// '--log-fd=3 '
292+
// "--log-file=$Valgrind_Log "
289293
. "--suppressions=$perl_supp --leak-check=yes "
290294
. "--leak-resolution=high --show-reachable=yes "
291-
. "--num-callers=50 --track-origins=yes";
295+
. "--num-callers=50 --track-origins=yes";
296+
# Force logging if not asked for (so cachegrind reporting works below)
297+
if ($vg_opts !~ /--log-file/) {
298+
$vg_opts = "--log-file=$Valgrind_Log $vg_opts";
299+
}
292300
$perl = "$valgrind_exe $vg_opts $perl";
293-
$redir = "3>$Valgrind_Log";
294-
if ($options->{run_dir}) {
295-
$Valgrind_Log = "$options->{run_dir}/$Valgrind_Log";
296-
}
297301
}
298302

299303
my $args = "$options->{testswitch} $options->{switch} $options->{utf8}";
@@ -310,6 +314,16 @@ sub _before_fork {
310314
chdir $run_dir or die "Can't chdir to '$run_dir': $!";
311315
}
312316

317+
# Remove previous valgrind output otherwise it will interfere
318+
my $test = $options->{test};
319+
320+
(local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
321+
322+
if ($ENV{PERL_VALGRIND} && -e $Valgrind_Log) {
323+
unlink $Valgrind_Log
324+
or warn "$0: Failed to unlink '$Valgrind_Log': $!\n";
325+
}
326+
313327
return;
314328
}
315329

@@ -553,7 +567,8 @@ EOT
553567
$te = '';
554568
}
555569

556-
(local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
570+
(local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
571+
557572
my $results = _run_test($test, $type);
558573

559574
my $failure;
@@ -653,62 +668,8 @@ EOT
653668
$failure = 'FAILED--no leader found' unless $seen_leader;
654669
}
655670

656-
if ($ENV{PERL_VALGRIND}) {
657-
$toolnm = $ENV{VALGRIND};
658-
$toolnm =~ s|.*/||; # keep basename
659-
my @valgrind; # gets content of file
660-
if (-e $Valgrind_Log) {
661-
if (open(V, $Valgrind_Log)) {
662-
@valgrind = <V>;
663-
close V;
664-
} else {
665-
warn "$0: Failed to open '$Valgrind_Log': $!\n";
666-
}
667-
}
668-
if ($ENV{VG_OPTS} =~ /(cachegrind)/ or $toolnm =~ /(perf)/) {
669-
$toolnm = $1;
670-
if ($toolnm eq 'perf') {
671-
# append perfs subcommand, not just stat
672-
my ($sub) = split /\s/, $ENV{VG_OPTS};
673-
$toolnm .= "-$sub";
674-
}
675-
if (rename $Valgrind_Log, "$test.$toolnm") {
676-
$grind_ct++;
677-
} else {
678-
warn "$0: Failed to create '$test.$toolnm': $!\n";
679-
}
680-
}
681-
elsif (@valgrind) {
682-
my $leaks = 0;
683-
my $errors = 0;
684-
for my $i (0..$#valgrind) {
685-
local $_ = $valgrind[$i];
686-
if (/^==\d+== ERROR SUMMARY: (\d+) errors? /) {
687-
$errors = $errors + $1; # there may be multiple error summaries
688-
} elsif (/^==\d+== LEAK SUMMARY:/) {
689-
for my $off (1 .. 4) {
690-
if ($valgrind[$i+$off] =~
691-
/(?:lost|reachable):\s+\d+ bytes in (\d+) blocks/) {
692-
$leaks = $leaks + $1;
693-
}
694-
}
695-
}
696-
}
697-
if ($errors or $leaks) {
698-
if (rename $Valgrind_Log, "$test.valgrind") {
699-
$grind_ct = $grind_ct + 1;
700-
} else {
701-
warn "$0: Failed to create '$test.valgrind': $!\n";
702-
}
703-
}
704-
} else {
705-
warn "No valgrind output?\n";
706-
}
707-
if (-e $Valgrind_Log) {
708-
unlink $Valgrind_Log
709-
or warn "$0: Failed to unlink '$Valgrind_Log': $!\n";
710-
}
711-
}
671+
_check_valgrind(\$toolnm, \$grind_ct, \$test);
672+
712673
if ($type eq 'deparse') {
713674
unlink "./$test.dp";
714675
}
@@ -830,16 +791,8 @@ SHRDLU_5
830791
print "wrote storable file: $fn\n";
831792
}
832793
}
833-
if ($ENV{PERL_VALGRIND}) {
834-
my $s = $grind_ct == 1 ? '' : 's';
835-
print "$grind_ct valgrind report$s created.\n", ;
836-
if ($toolnm eq 'cachegrind') {
837-
# cachegrind leaves a lot of cachegrind.out.$pid litter
838-
# around the tree, find and delete them
839-
unlink _find_files('cachegrind.out.\d+$',
840-
qw ( ../t ../cpan ../ext ../dist/ ));
841-
}
842-
}
794+
795+
_cleanup_valgrind(\$toolnm, \$grind_ct);
843796
}
844797
exit ($::bad_files != 0);
845798

@@ -874,4 +827,82 @@ sub gather_conf_platform_info {
874827
);
875828
}
876829

830+
sub _check_valgrind {
831+
return unless $ENV{PERL_VALGRIND};
832+
833+
my ($toolnm, $grind_ct, $test) = @_;
834+
835+
$$toolnm = $ENV{VALGRIND};
836+
$$toolnm =~ s|.*/||; # keep basename
837+
my @valgrind; # gets content of file
838+
if (-e $Valgrind_Log) {
839+
if (open(V, $Valgrind_Log)) {
840+
@valgrind = <V>;
841+
close V;
842+
} else {
843+
warn "$0: Failed to open '$Valgrind_Log': $!\n";
844+
}
845+
}
846+
if ($ENV{VG_OPTS} =~ /(cachegrind)/ or $$toolnm =~ /(perf)/) {
847+
$$toolnm = $1;
848+
if ($$toolnm eq 'perf') {
849+
# append perfs subcommand, not just stat
850+
my ($sub) = split /\s/, $ENV{VG_OPTS};
851+
$$toolnm .= "-$sub";
852+
}
853+
if (rename $Valgrind_Log, "$$test.$$toolnm") {
854+
$$grind_ct++;
855+
} else {
856+
warn "$0: Failed to create '$$test.$$toolnm': $!\n";
857+
}
858+
}
859+
elsif (@valgrind) {
860+
my $leaks = 0;
861+
my $errors = 0;
862+
for my $i (0..$#valgrind) {
863+
local $_ = $valgrind[$i];
864+
if (/^==\d+== ERROR SUMMARY: (\d+) errors? /) {
865+
$errors = $errors + $1; # there may be multiple error summaries
866+
} elsif (/^==\d+== LEAK SUMMARY:/) {
867+
for my $off (1 .. 4) {
868+
if ($valgrind[$i+$off] =~
869+
/(?:lost|reachable):\s+\d+ bytes in (\d+) blocks/) {
870+
$leaks = $leaks + $1;
871+
}
872+
}
873+
}
874+
}
875+
if ($errors or $leaks) {
876+
if (rename $Valgrind_Log, "$$test.valgrind") {
877+
$$grind_ct = $$grind_ct + 1;
878+
} else {
879+
warn "$0: Failed to create '$$test.valgrind': $!\n";
880+
}
881+
}
882+
} else {
883+
# Quiet wasn't asked for? Something may be amiss
884+
if ($ENV{VG_OPTS} && $ENV{VG_OPTS} !~ /(^|\s)(-q|--quiet)(\s|$)/) {
885+
warn "No valgrind output?\n";
886+
}
887+
}
888+
if (-e $Valgrind_Log) {
889+
unlink $Valgrind_Log
890+
or warn "$0: Failed to unlink '$Valgrind_Log': $!\n";
891+
}
892+
}
893+
894+
sub _cleanup_valgrind {
895+
return unless $ENV{PERL_VALGRIND};
896+
897+
my ($toolnm, $grind_ct) = @_;
898+
my $s = $$grind_ct == 1 ? '' : 's';
899+
print "$$grind_ct valgrind report$s created.\n", ;
900+
if ($$toolnm eq 'cachegrind') {
901+
# cachegrind leaves a lot of cachegrind.out.$pid litter
902+
# around the tree, find and delete them
903+
unlink _find_files('cachegrind.out.\d+$',
904+
qw ( ../t ../cpan ../ext ../dist/ ));
905+
}
906+
}
907+
877908
# ex: set ts=8 sts=4 sw=4 noet:

‎t/harness

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,10 +16,15 @@ use Config;
1616

1717
$::do_nothing = $::do_nothing = 1;
1818
require './TEST';
19+
our $Valgrind_Log;
1920

2021
my $Verbose = 0;
2122
$Verbose++ while @ARGV && $ARGV[0] eq '-v' && shift;
2223

24+
# For valgrind summary output
25+
my $htoolnm;
26+
my $hgrind_ct;
27+
2328
if ($ARGV[0] && $ARGV[0] eq '-torture') {
2429
shift;
2530
$torture = 1;
@@ -224,10 +229,34 @@ my $h = TAP::Harness->new({
224229
$options = $options{$test} = _scan_test($test, $type);
225230
}
226231

232+
(local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
233+
227234
return [ split ' ', _cmd($options, $type) ];
228235
},
229236
});
230237

238+
# Print valgrind output after test completes
239+
if ($ENV{PERL_VALGRIND}) {
240+
$h->callback(
241+
after_test => sub {
242+
my ($job) = @_;
243+
my $test = $job->[0];
244+
my $vfile = "$test.valgrind-current";
245+
$vfile =~ s/^.*\///;
246+
247+
if ( (! -z $vfile) && open(my $voutput, '<', $vfile)) {
248+
print "$test: Valgrind output:\n";
249+
print "$test: $_" for <$voutput>;
250+
close($voutput);
251+
}
252+
253+
(local $Valgrind_Log = "$test.valgrind-current") =~ s/^.*\///;
254+
255+
_check_valgrind(\$htoolnm, \$hgrind_ct, \$test);
256+
}
257+
);
258+
}
259+
231260
if ($state) {
232261
$h->callback(
233262
after_test => sub {
@@ -260,4 +289,5 @@ $h->callback(
260289
);
261290

262291
my $agg = $h->runtests(@tests);
292+
_cleanup_valgrind(\$htoolnm, \$hgrind_ct);
263293
exit $agg->has_errors ? 1 : 0;

0 commit comments

Comments
 (0)