X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FValgrind%2FSession.pm;h=27aa97344c3d8b4c474c889e3ce9f06df2843ea5;hb=2d1051a7ab93eee13b726edd0b353342e683bc2b;hp=fe521a0e0907ef8edc18d36c253c538131b4af83;hpb=270aacc7f116b97928f9d70ce7936dd9d0a78ce0;p=perl%2Fmodules%2FTest-Valgrind.git diff --git a/lib/Test/Valgrind/Session.pm b/lib/Test/Valgrind/Session.pm index fe521a0..27aa973 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.02 +Version 1.11 =cut -our $VERSION = '1.02'; +our $VERSION = '1.11'; =head1 DESCRIPTION @@ -22,15 +22,13 @@ It also acts as a dispatcher between the different components. =cut -# All these modules are required at configure time. +use File::Spec (); +use Scalar::Util (); -BEGIN { - require File::Spec; - require Scalar::Util; +use Fcntl (); # F_SETFD +use POSIX (); # SIGKILL - require Fcntl; # F_SETFD - require POSIX; # SIGKILL -} +use version (); use base qw/Test::Valgrind::Carp/; @@ -78,11 +76,6 @@ Defaults to none. =cut -my $build_version = sub { - require version; - version->new($_[0]); -}; - sub new { my $class = shift; $class = ref($class) || $class; @@ -90,7 +83,7 @@ sub new { my %args = @_; my @paths; - my $vg = delete $args{vg}; + my $vg = delete $args{valgrind}; if (defined $vg and not ref $vg) { @paths = ($vg); } else { @@ -103,7 +96,7 @@ sub new { $class->_croak('Empty valgrind candidates list') unless @paths; my $min_version = delete $args{min_version}; - defined and not ref and $_ = $build_version->($_) for $min_version; + defined and not ref and $_ = version->new($_) for $min_version; my ($valgrind, $version); for (@paths) { @@ -111,7 +104,7 @@ sub new { my $ver = qx/$_ --version/; if ($ver =~ /^valgrind-(\d+(\.\d+)*)/) { if ($min_version) { - $version = $build_version->($1); + $version = version->new($1); next if $version < $min_version; } else { $version = $1; @@ -149,7 +142,7 @@ sub version { my ($self) = @_; my $version = $self->{version}; - $self->{version} = $version = $build_version->($version) unless ref $version; + $self->{version} = $version = version->new($version) unless ref $version; return $version; } @@ -225,7 +218,11 @@ sub _run { "Suppressions for this perl stored in $def_supp" )); } - push @supp_args, '--suppressions=' . $_ for $self->suppressions; + for ($self->suppressions) { + next unless -e $_; + $self->report($self->report_class->new_diag("Using suppression file $_")); + push @supp_args, "--suppressions=$_"; + } } pipe my $vrdr, my $vwtr or $self->_croak("pipe(\$vrdr, \$vwtr): $!"); @@ -284,6 +281,10 @@ Read-only accessor for the C associated to the current run. Read-only accessor for the C associated to the current run. +=head2 C + +Read-only accessor for the C associated to the current tool. + =head2 C Read-only accessor for the C associated to the current run. @@ -307,9 +308,17 @@ Forwards to C<< ->action->do_suppressions >>. sub do_suppressions { $_[0]->action->do_suppressions } +=head2 C + +Calls C<< ->tool->parser_class >> with the current session object as the unique argument. + +=cut + +sub parser_class { $_[0]->tool->parser_class($_[0]) } + =head2 C -Calls C<< ->action->report_class >> with the current session object as the unique argument. +Calls C<< ->tool->report_class >> with the current session object as the unique argument. =cut @@ -388,7 +397,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->parser($self->parser_class->new)->start($self); $self->action->start($self); return;