return;
}
}
- pipe my $rdr, my $wtr or die "pipe(\$rdr, \$wtr): $!";
+ pipe my $ordr, my $owtr or die "pipe(\$ordr, \$owtr): $!";
+ pipe my $vrdr, my $vwtr or die "pipe(\$vrdr, \$vwtr): $!";
my $pid = fork;
if (!defined $pid) {
die "fork(): $!";
} elsif ($pid == 0) {
setpgrp 0, 0 or die "setpgrp(0, 0): $!";
- close $rdr or die "close(\$rdr): $!";
- fcntl $wtr, F_SETFD, 0 or die "fcntl(\$wtr, F_SETFD, 0): $!";
+ close $ordr or die "close(\$ordr): $!";
+ open STDOUT, '>&=', $owtr or die "open(STDOUT, '>&=', \$owtr): $!";
+ close $vrdr or die "close(\$vrdr): $!";
+ fcntl $vwtr, F_SETFD, 0 or die "fcntl(\$vwtr, F_SETFD, 0): $!";
my @args = (
'--tool=memcheck',
'--leak-check=full',
'--leak-resolution=high',
'--num-callers=' . $callers,
'--error-limit=yes',
- '--log-fd=' . fileno($wtr)
+ '--log-fd=' . fileno($vwtr)
);
unless ($args{no_supp}) {
for (Test::Valgrind::Suppressions::supp_path(), $args{supp}) {
push @args, $^X;
push @args, '-I' . $_ for @INC;
push @args, '-MTest::Valgrind=run,1', $file;
- print STDERR "valgrind @args\n" if $args{diag};
+ print STDOUT "valgrind @args\n";
local $ENV{PERL_DESTRUCT_LEVEL} = 3;
local $ENV{PERL_DL_NONLAZY} = 1;
exec $vg, @args;
}
- close $wtr or die "close(\$wtr): $!";
local $SIG{INT} = sub { kill -(SIGTERM) => $pid };
$Test->plan(tests => 5) unless $args{no_test} or defined $Test->has_plan;
my @tests = (
'definitely lost', 'indirectly lost', 'possibly lost', 'still reachable'
);
my %res = map { $_ => 0 } @tests;
- while (<$rdr>) {
+ close $owtr or die "close(\$owtr): $!";
+ $Test->diag(do { local $/; <$ordr> }) if $args{diag};
+ close $ordr or die "close(\$ordr): $!";
+ close $vwtr or die "close(\$vwtr): $!";
+ while (<$vrdr>) {
$Test->diag($_) if $args{diag};
if (/^=+\d+=+\s*FATAL\s*:\s*(.*)/) {
chomp(my $err = $1);