X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FValgrind%2FSession.pm;h=fe521a0e0907ef8edc18d36c253c538131b4af83;hb=270aacc7f116b97928f9d70ce7936dd9d0a78ce0;hp=705e08840c21fe7bc7f1dc1b94f23fbbd391d13f;hpb=92653294359c822a0f3720d6cc7a491978168c7c;p=perl%2Fmodules%2FTest-Valgrind.git diff --git a/lib/Test/Valgrind/Session.pm b/lib/Test/Valgrind/Session.pm index 705e088..fe521a0 100644 --- a/lib/Test/Valgrind/Session.pm +++ b/lib/Test/Valgrind/Session.pm @@ -34,8 +34,6 @@ BEGIN { use base qw/Test::Valgrind::Carp/; -use Test::Valgrind::Report; - =head1 METHODS =head2 C<< new search_dirs => \@search_dirs, valgrind => [ $valgrind | \@valgrind ], min_version => $min_version, no_def_supp => $no_def_supp, extra_supps => \@extra_supps >> @@ -201,7 +199,7 @@ sub _run { $self->command($cmd); - $self->report(Test::Valgrind::Report->new_diag( + $self->report($self->report_class->new_diag( 'Using valgrind ' . $self->version . ' located at ' . $self->valgrind )); @@ -213,7 +211,7 @@ sub _run { } 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( + $self->report($self->report_class->new_diag( "Generating suppressions..." )); require Test::Valgrind::Suppressions; @@ -223,7 +221,7 @@ sub _run { target => $def_supp, ); $self->_croak('Couldn\'t generate suppressions') unless -e $def_supp; - $self->report(Test::Valgrind::Report->new_diag( + $self->report($self->report_class->new_diag( "Suppressions for this perl stored in $def_supp" )); } @@ -248,13 +246,13 @@ sub _run { my @args = ( $self->valgrind, - '--log-fd=' . fileno($vwtr), $self->tool->args($self), @supp_args, + $self->parser->args($self, $vwtr), $self->command->args($self), ); -# $self->report(Test::Valgrind::Report->new_diag("@args")); +# $self->report($self->report_class->new_diag("@args")); exec { $args[0] } @args or $self->_croak("exec @args: $!"); } @@ -267,7 +265,7 @@ sub _run { close $vwtr or $self->_croak("close(\$vwtr): $!"); - $self->tool->parse($self, $vrdr); + $self->parser->parse($self, $vrdr); $self->{exit_code} = (waitpid($pid, 0) == $pid) ? $? >> 8 : 255; @@ -294,7 +292,7 @@ Read-only accessor for the C associated to the current run. my @members; BEGIN { - @members = qw/action tool command/; + @members = qw/action tool command parser/; for (@members) { eval "sub $_ { \@_ <= 1 ? \$_[0]->{$_} : (\$_[0]->{$_} = \$_[1]) }"; die if $@; @@ -379,7 +377,7 @@ sub start { my %args = @_; - for (@members) { + for (qw/action tool command/) { my $base = 'Test::Valgrind::' . ucfirst; my $value = $args{$_}; $self->_croak("Invalid $_") unless Scalar::Util::blessed($value) @@ -390,6 +388,7 @@ sub start { delete @{$self}{qw/last_status exit_code/}; $self->tool->start($self); + $self->parser($self->tool->parser_class($self)->new)->start($self); $self->action->start($self); return; @@ -403,6 +402,7 @@ Forwards to C<< ->action->abort >> after unshifting the session object to the ar sub abort { my $self = shift; + $self->action->abort($self, @_); } @@ -417,8 +417,10 @@ sub report { return unless defined $report; - $report = $self->command->filter($self, $report); - return unless defined $report; + for my $handler (qw/tool command/) { + $report = $self->$handler->filter($self, $report); + return unless defined $report; + } $self->action->report($self, $report); } @@ -434,7 +436,9 @@ sub finish { my ($self) = @_; my $action = $self->action; + $action->finish($self); + $self->parser->finish($self); $self->tool->finish($self); my $status = $action->status($self); @@ -455,7 +459,7 @@ sub status { $_[0]->{last_status} } =head1 SEE ALSO -L, L, L, L. +L, L, L, L, L. L, L.