Don't try to read the script's output before valgrind's, as it causes deadlocks

[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind.pm

diff --git a/lib/Test/Valgrind.pm b/lib/Test/Valgrind.pm
index 4c87dec50d47265a6d58190eea10d990b1f814ee..c76231d07ba5dada26053ea4e75e9010c996dc98 100644 (file)
--- a/lib/Test/Valgrind.pm
+++ b/lib/Test/Valgrind.pm
@@ -163,6 +163,7 @@ sub import {
    close $vrdr or die "close(\$vrdr): $!";
    fcntl $vwtr, F_SETFD, 0 or die "fcntl(\$vwtr, F_SETFD, 0): $!";
    my @args = (
+    $vg,
     '--tool=memcheck',
     '--leak-check=full',
     '--leak-resolution=high',
@@ -184,7 +185,8 @@ sub import {
    print STDOUT "valgrind @args\n";
    local $ENV{PERL_DESTRUCT_LEVEL} = 3;
    local $ENV{PERL_DL_NONLAZY} = 1;
-   exec $vg, @args;
+   exec { $args[0] } @args;
+   die "exec @args: $!";
   }
   local $SIG{INT} = sub { kill -(SIGTERM) => $pid };
   $Test->plan(tests => 5) unless $args{no_test} or defined $Test->has_plan;
@@ -194,8 +196,6 @@ sub import {
   );
   my %res = map { $_ => 0 } @tests;
   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};
@@ -216,6 +216,8 @@ sub import {
    }
   }
   waitpid $pid, 0;
+  $Test->diag(do { local $/; <$ordr> }) if $args{diag};
+  close $ordr or die "close(\$ordr): $!";
   my $failed = 5;
   my $cb = ($args{no_test} ? \&_counter
                            : ($args{cb} ? $args{cb} : \&_tester));