X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FValgrind%2FCommand%2FPerl.pm;h=b701fec7d17cde89d61bf56d59f30cfb5cc92392;hb=d83358595540f8645467c2d1a2f658fa74b14c72;hp=3ded74a587c7ebbbb2f3cf61a4200a3a72b1b493;hpb=11eeabaad0bbb6db15b9c967fae94cd7388f0012;p=perl%2Fmodules%2FTest-Valgrind.git

diff --git a/lib/Test/Valgrind/Command/Perl.pm b/lib/Test/Valgrind/Command/Perl.pm
index 3ded74a..b701fec 100644
--- a/lib/Test/Valgrind/Command/Perl.pm
+++ b/lib/Test/Valgrind/Command/Perl.pm
@@ -9,25 +9,37 @@ Test::Valgrind::Command::Perl - A Test::Valgrind command that invokes perl.
 
 =head1 VERSION
 
-Version 1.01
+Version 1.13
 
 =cut
 
-our $VERSION = '1.01';
+our $VERSION = '1.13';
 
 =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 base qw/Test::Valgrind::Command Test::Valgrind::Carp/;
+use Test::Valgrind::Suppressions;
+
+use base qw<Test::Valgrind::Command Test::Valgrind::Carp>;
 
 =head1 METHODS
 
 This class inherits L<Test::Valgrind::Command>.
 
-=head2 C<< new perl => $^X, inc => \@INC, taint_mode => $taint_mode, ... >>
+=head2 C<new>
+
+    my $tvcp = Test::Valgrind::Command::Perl->new(
+     perl       => $^X,
+     inc        => \@INC,
+     taint_mode => $taint_mode,
+     %extra_args,
+    );
 
 The package constructor, which takes several options :
 
@@ -102,6 +114,8 @@ sub new_trainer {
 
 =head2 C<perl>
 
+    my $perl = $tvcp->perl;
+
 Read-only accessor for the C<perl> option.
 
 =cut
@@ -110,6 +124,8 @@ sub perl { $_[0]->{perl} }
 
 =head2 C<inc>
 
+    my @inc = $tvcp->inc;
+
 Read-only accessor for the C<inc> option.
 
 =cut
@@ -118,6 +134,8 @@ sub inc { @{$_[0]->{inc} || []} }
 
 =head2 C<taint_mode>
 
+    my $taint_mode = $tvcp->taint_mode;
+
 Read-only accessor for the C<taint_mode> option.
 
 =cut
@@ -133,7 +151,9 @@ sub args {
         $self->SUPER::args(@_);
 }
 
-=head2 C<env $session>
+=head2 C<env>
+
+    my $env = $tvcp->env($session);
 
 Returns an L<Env::Sanctify> object that sets the environment variables C<PERL_DESTRUCT_LEVEL> to C<3> and C<PERL_DL_NONLAZY> to C<1> during the run.
 
@@ -142,7 +162,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 +186,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) = @_;
 
@@ -202,7 +239,7 @@ You can find documentation for this module with the perldoc command.
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2009 Vincent Pit, all rights reserved.
+Copyright 2009,2010,2011 Vincent Pit, all rights reserved.
 
 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 
@@ -248,7 +285,7 @@ my @cards = List::Util::shuffle(0 .. 51);
 {
  package Test::Valgrind::Test::Fake;
 
- use base qw/strict/;
+ use base qw<strict>;
 }
 
-eval 'use Time::HiRes qw/usleep/';
+eval 'use Time::HiRes qw<usleep>';