X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FValgrind%2FSession.pm;h=705e08840c21fe7bc7f1dc1b94f23fbbd391d13f;hb=74358c574d25781638689e3c3833b07928f17a02;hp=3174bdef84d6962962d1457bbf5882405cb0ea05;hpb=0e79c45af8d5eabe900280cc0e5467936467dee9;p=perl%2Fmodules%2FTest-Valgrind.git diff --git a/lib/Test/Valgrind/Session.pm b/lib/Test/Valgrind/Session.pm index 3174bde..705e088 100644 --- a/lib/Test/Valgrind/Session.pm +++ b/lib/Test/Valgrind/Session.pm @@ -9,11 +9,11 @@ Test::Valgrind::Session - Test::Valgrind session object. =head1 VERSION -Version 1.01 +Version 1.02 =cut -our $VERSION = '1.01'; +our $VERSION = '1.02'; =head1 DESCRIPTION @@ -210,21 +210,22 @@ sub _run { my @supp_args; if ($self->do_suppressions) { push @supp_args, '--gen-suppressions=all'; - } else { - my @supps; - if (not $self->no_def_supp) { - my $def_supp = $self->def_supp_file; - if (defined $def_supp and not -e $def_supp) { - $self->report(Test::Valgrind::Report->new_diag("Generating suppressions...")); - require Test::Valgrind::Suppressions; - Test::Valgrind::Suppressions->generate( - tool => $self->tool, - command => $self->command, - target => $def_supp, - ); - $self->_croak('Couldn\'t generate suppressions') unless -e $def_supp; - $self->report(Test::Valgrind::Report->new_diag("Suppressions for this perl stored in $def_supp")); - } + } elsif (not $self->no_def_supp) { + my $def_supp = $self->def_supp_file; + if (defined $def_supp and not -e $def_supp) { + $self->report(Test::Valgrind::Report->new_diag( + "Generating suppressions..." + )); + require Test::Valgrind::Suppressions; + Test::Valgrind::Suppressions->generate( + tool => $self->tool, + command => $self->command, + target => $def_supp, + ); + $self->_croak('Couldn\'t generate suppressions') unless -e $def_supp; + $self->report(Test::Valgrind::Report->new_diag( + "Suppressions for this perl stored in $def_supp" + )); } push @supp_args, '--suppressions=' . $_ for $self->suppressions; } @@ -310,7 +311,7 @@ sub do_suppressions { $_[0]->action->do_suppressions } =head2 C -Calls C<< ->action->report_class >> with the current session object as the sole argument. +Calls C<< ->action->report_class >> with the current session object as the unique argument. =cut @@ -412,8 +413,14 @@ Forwards to C<< ->action->report >> after unshifting the session object to the a =cut sub report { - my $self = shift; - $self->action->report($self, @_); + my ($self, $report) = @_; + + return unless defined $report; + + $report = $self->command->filter($self, $report); + return unless defined $report; + + $self->action->report($self, $report); } =head2 C