X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FValgrind.pm;h=c76231d07ba5dada26053ea4e75e9010c996dc98;hb=d3122f78d2a044f117a0e03fbc7dbd45d603eb47;hp=a6561301481845a44c87241ecf75fc39f67dec94;hpb=987e9c3448c1fc1668b162e3d25c39f6593ba000;p=perl%2Fmodules%2FTest-Valgrind.git

diff --git a/lib/Test/Valgrind.pm b/lib/Test/Valgrind.pm
index a656130..c76231d 100644
--- a/lib/Test/Valgrind.pm
+++ b/lib/Test/Valgrind.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use Carp qw/croak/;
 use POSIX qw/SIGTERM/;
+use Fcntl qw/F_SETFD/;
 use Test::Builder;
 
 use Perl::Destruct::Level level => 3;
@@ -146,24 +147,29 @@ sub import {
     }
    }
    if (!$vg) {
-    $Test->plan(skip_all => 'No valgrind executable could be found in your path');
+    $Test->skip_all('No valgrind executable could be found in your path');
     return;
    } 
   }
-  pipe my $rdr, my $wtr or croak "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) {
-   croak "fork(): $!";
+   die "fork(): $!";
   } elsif ($pid == 0) {
-   setpgrp 0, 0 or croak "setpgrp(0, 0): $!";
-   close $rdr or croak "close(\$rdr): $!";
-   open STDERR, '>&', $wtr or croak "open(STDERR, '>&', \$wtr): $!";
+   setpgrp 0, 0 or die "setpgrp(0, 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 = (
+    $vg,
     '--tool=memcheck',
     '--leak-check=full',
     '--leak-resolution=high',
     '--num-callers=' . $callers,
-    '--error-limit=yes'
+    '--error-limit=yes',
+    '--log-fd=' . fileno($vwtr)
    );
    unless ($args{no_supp}) {
     for (Test::Valgrind::Suppressions::supp_path(), $args{supp}) {
@@ -176,20 +182,22 @@ sub import {
    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;
+   exec { $args[0] } @args;
+   die "exec @args: $!";
   }
-  close $wtr or croak "close(\$wtr): $!";
   local $SIG{INT} = sub { kill -(SIGTERM) => $pid };
-  $Test->plan(tests => 5) unless $args{no_test};
+  $Test->plan(tests => 5) unless $args{no_test} or defined $Test->has_plan;
   my @tests = (
    'errors',
    'definitely lost', 'indirectly lost', 'possibly lost', 'still reachable'
   );
   my %res = map { $_ => 0 } @tests;
-  while (<$rdr>) {
+  close $owtr or die "close(\$owtr): $!";
+  close $vwtr or die "close(\$vwtr): $!";
+  while (<$vrdr>) {
    $Test->diag($_) if $args{diag};
    if (/^=+\d+=+\s*FATAL\s*:\s*(.*)/) {
     chomp(my $err = $1);
@@ -208,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));
@@ -234,7 +244,7 @@ If your tests output to STDERR, everything will be eaten in the process. In part
 
 Valgrind 3.1.0 (L<http://valgrind.org>).
 
-L<Carp>, L<POSIX> (core modules since perl 5) and L<Test::Builder> (since 5.6.2).
+L<Carp>, L<Fcntl>, L<POSIX> (core modules since perl 5) and L<Test::Builder> (since 5.6.2).
 
 L<Perl::Destruct::Level>.