]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - t/lib/Test/Valgrind/Test/Action.pm
Remove support for report_class_{suppressions,analysis} in tools
[perl/modules/Test-Valgrind.git] / t / lib / Test / Valgrind / Test / Action.pm
1 package Test::Valgrind::Test::Action;
2
3 use strict;
4 use warnings;
5
6 use base qw/Test::Valgrind::Action::Test/;
7
8 my $extra_tests;
9
10 BEGIN {
11  eval {
12   require Test::Valgrind;
13   require XSLoader;
14   XSLoader::load('Test::Valgrind', $Test::Valgrind::VERSION);
15  };
16  if ($@) {
17   $extra_tests = 0;
18  } else {
19   $extra_tests = 2;
20   *report = *report_smart;
21  }
22 }
23
24 use Test::Builder;
25
26 sub new { shift->SUPER::new(extra_tests => $extra_tests) }
27
28 sub report_smart {
29  my ($self, $sess, $report) = @_;
30
31  if ($report->can('is_leak') and $report->is_leak) {
32   my $data  = $report->data;
33   my $trace = join ' ', map { $_->[2] } @{$data->{stack} || []}[0 .. 2];
34   if ($trace eq 'malloc XS_Test__Valgrind_leak Perl_pp_entersub') {
35    my $tb = Test::Builder->new;
36    $tb->diag("The subsequent report was correctly caught:\n" . $report->dump);
37    $tb->is_eq($data->{leakedbytes},  10_000, '10_000 bytes leaked');
38    $tb->is_eq($data->{leakedblocks}, 1,      '  in one block');
39    return;
40   }
41  }
42
43  $self->SUPER::report($sess, $report);
44 }
45
46 1;