]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/commitdiff
Capture STDOUT so that its output doesn't mix with our test results
authorVincent Pit <vince@profvince.com>
Sun, 28 Sep 2008 11:52:59 +0000 (13:52 +0200)
committerVincent Pit <vince@profvince.com>
Sun, 28 Sep 2008 11:52:59 +0000 (13:52 +0200)
lib/Test/Valgrind.pm
t/20-good.t
t/21-good-block.t

index a676ad0c5d484a44f7c0f339a424b2bb826efb0e..4c87dec50d47265a6d58190eea10d990b1f814ee 100644 (file)
@@ -151,21 +151,24 @@ sub import {
     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}) {
@@ -178,12 +181,11 @@ 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;
   }
-  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 = (
@@ -191,7 +193,11 @@ sub import {
    '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);
index 510a0a359e63a9f84a914361e0db3623f0bc2106..4c31222b06767d8a8a91cd726a378beaab174002 100644 (file)
@@ -11,4 +11,5 @@ if ($@) {
  plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind';
 }
 
-1;
+plan tests => 1;
+fail('shouldn\'t see this');
index 272ea53fd04770dc6a0992df7c95ff538bdf3592..22d3c47b3e2f65a52acf750bcb04a66d790f939a 100644 (file)
@@ -11,4 +11,5 @@ if ($@) {
  plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind';
 }
 
-1;
+plan tests => 1;
+fail('shouldn\'t see this');