This is 1.12

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

diff --git a/lib/Test/Valgrind/Command/Perl.pm b/lib/Test/Valgrind/Command/Perl.pm
index 3ded74a587c7ebbbb2f3cf61a4200a3a72b1b493..1894b8d813feb8c1d16754df1aaf2521acafeaab 100644 (file)
--- a/lib/Test/Valgrind/Command/Perl.pm
+++ b/lib/Test/Valgrind/Command/Perl.pm
@@ -9,18 +9,23 @@ Test::Valgrind::Command::Perl - A Test::Valgrind command that invokes perl.
 
 =head1 VERSION
 
-Version 1.01
+Version 1.12
 
 =cut
 
-our $VERSION = '1.01';
+our $VERSION = '1.12';
 
 =head1 DESCRIPTION
 
+This command is the base for all C<perl>-based commands.
+It handles the suppression generation and sets the main command-line flags.
+
 =cut
 
 use Env::Sanctify ();
 
+use Test::Valgrind::Suppressions;
+
 use base qw/Test::Valgrind::Command Test::Valgrind::Carp/;
 
 =head1 METHODS
@@ -142,7 +147,7 @@ Returns an L<Env::Sanctify> object that sets the environment variables C<PERL_DE
 sub env {
  Env::Sanctify->sanctify(
   env => {
-   PERL_DESTRUCT_LEVEL => 2,
+   PERL_DESTRUCT_LEVEL => 3,
    PERL_DL_NONLAZY     => 1,
   },
  );
@@ -166,6 +171,23 @@ sub suppressions_tag {
  return $self->{suppressions_tag};
 }
 
+sub filter {
+ my ($self, $session, $report) = @_;
+
+ return $report if $report->is_diag
+                or not $report->isa('Test::Valgrind::Report::Suppressions');
+
+ my $data = $report->data;
+ $data =~ s/[^\r\n]*\bPerl_runops_(?:standard|debug)\b.*//s;
+ $data = Test::Valgrind::Suppressions->strip_tail($session, $data);
+
+ $report->new(
+  id   => $report->id,
+  kind => $report->kind,
+  data => $data,
+ );
+}
+
 sub DESTROY {
  my ($self) = @_;