Make sure t/20-bad.t does no extra checks when no valgrind was found

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

diff --git a/t/lib/Test/Valgrind/Test/Action.pm b/t/lib/Test/Valgrind/Test/Action.pm
index 6912cbd73fd0aed20d173784eddc3b81b0dff672..3f9c0c7bea7632e3ae3cd07d01eb7c7fc7e2bd14 100644 (file)
--- a/t/lib/Test/Valgrind/Test/Action.pm
+++ b/t/lib/Test/Valgrind/Test/Action.pm
@@ -3,7 +3,7 @@ package Test::Valgrind::Test::Action;
 use strict;
 use warnings;
 
-use base qw/Test::Valgrind::Action::Test/;
+use base qw<Test::Valgrind::Action::Test>;
 
 my $extra_tests;
 
@@ -16,30 +16,81 @@ BEGIN {
  if ($@) {
   $extra_tests = 0;
  } else {
-  $extra_tests = 2;
+  $extra_tests = 3;
   *report = *report_smart;
+  *abort  = *abort_smart;
  }
 }
 
 use Test::Builder;
 
-sub new { shift->SUPER::new(extra_tests => $extra_tests) }
+sub new {
+ my $class = shift;
+
+ $class->SUPER::new(
+  diag        => 1,
+  extra_tests => $extra_tests,
+ );
+}
+
+my @filtered_reports;
 
 sub report_smart {
  my ($self, $sess, $report) = @_;
 
  if ($report->can('is_leak') and $report->is_leak) {
-  my $tb = Test::Builder->new;
-  my $data = $report->data;
-  $tb->is_eq($data->{leakedbytes},  10_000, '10_000 bytes leaked');
-  $tb->is_eq($data->{leakedblocks}, 1,      '  in one block');
-  $tb->diag("The subsequent report was correctly caught:\n" . $report->dump)
-                                      if  ($data->{leakedbytes}  || 0) == 10_000
-                                      and ($data->{leakedblocks} || 0) == 1;
-  return;
+  my $data  = $report->data;
+  my @trace = map $_->[2] || '?',
+               @{$data->{stack} || []}[0 .. 3];
+  my $valid_trace = (
+       $trace[0] eq 'malloc'
+   and $trace[1] eq 'tv_leak'
+   and ($trace[2] eq 'Perl_pp_entersub' or $trace[3] eq 'Perl_pp_entersub')
+  );
+
+  if ($valid_trace) {
+   push @filtered_reports, [
+    $report->dump,
+    $data->{leakedbytes},
+    $data->{leakedblocks},
+   ];
+   return;
+  }
  }
 
  $self->SUPER::report($sess, $report);
 }
 
+sub abort_smart {
+ my $self = shift;
+
+ $extra_tests = 0;
+
+ $self->SUPER::abort(@_);
+}
+
+sub DESTROY {
+ return unless $extra_tests;
+
+ my $tb = Test::Builder->new;
+
+ $tb->is_eq(scalar(@filtered_reports), 1, 'caught one extra leak');
+
+ if (@filtered_reports) {
+  my $first = shift @filtered_reports;
+  $tb->diag("The subsequent report was correctly caught:\n" . $first->[0]);
+  $tb->is_eq($first->[1], 10_000, '10_000 bytes leaked');
+  $tb->is_eq($first->[2], 1,      '  in one block');
+
+  for my $extra_report (@filtered_reports) {
+   $tb->diag(
+    "The subsequent report should NOT have been caught:\n" . $extra_report->[0]
+   );
+  }
+ } else {
+  $tb->ok(0, 'no extra leak caught, hence no bytes leaked');
+  $tb->ok(0, 'no extra leak caught, hence no block leaked');
+ }
+}
+
 1;