X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FValgrind%2FSession.pm;h=b0069df7fdf1c2534218f2b644d42a75a8add912;hb=39af0cb1411f565d286cd656a7a0bdd3d3ba07fb;hp=51fd0bde779afdb0504aadb5a6c02b1ec521e1b1;hpb=2c6dde5f6603362e3f4bccc9994bf823e8bb06f1;p=perl%2Fmodules%2FTest-Valgrind.git

diff --git a/lib/Test/Valgrind/Session.pm b/lib/Test/Valgrind/Session.pm
index 51fd0bd..b0069df 100644
--- a/lib/Test/Valgrind/Session.pm
+++ b/lib/Test/Valgrind/Session.pm
@@ -230,26 +230,25 @@ If the command is a L<Test::Valgrind::Command::Aggregate> object, the action and
 =cut
 
 sub run {
- my $self = shift;
-
- my %args = @_;
-
- $self->start(%args);
- my $guard = Test::Valgrind::Session::Guard->new(sub { $self->finish });
+ my ($self, %args) = @_;
 
- $self->_run($args{command});
-}
-
-sub _run {
- my ($self, $cmd) = @_;
+ for (qw<action tool command>) {
+  my $base = 'Test::Valgrind::' . ucfirst;
+  my $value = $args{$_};
+  $self->_croak("Invalid $_") unless Scalar::Util::blessed($value)
+                                                         and $value->isa($base);
+  $self->$_($args{$_})
+ }
 
+ my $cmd = $self->command;
  if ($cmd->isa('Test::Valgrind::Command::Aggregate')) {
-  $self->_run($_) for $cmd->commands;
+  for my $subcmd ($cmd->commands) {
+   $args{command} = $subcmd;
+   $self->run(%args);
+  }
   return;
  }
 
- $self->command($cmd);
-
  $self->report($self->report_class->new_diag(
   'Using valgrind ' . $self->version . ' located at ' . $self->valgrind
  ));
@@ -303,6 +302,9 @@ sub _run {
   @supp_args = map "--suppressions=$_", @supp_files;
  }
 
+ my $guard = Test::Valgrind::Session::Guard->new(sub { $self->finish });
+ $self->start;
+
  pipe my $vrdr, my $vwtr or $self->_croak("pipe(\$vrdr, \$vwtr): $!");
  {
   my $oldfh = select $vrdr;
@@ -338,12 +340,14 @@ sub _run {
  local $SIG{INT} = sub {
   kill -(POSIX::SIGKILL()) => $pid;
   waitpid $pid, 0;
-  die 'interrupted';
+  die 'valgrind analysis was interrupted';
  };
 
  close $vwtr or $self->_croak("close(\$vwtr): $!");
 
- $self->parser->parse($self, $vrdr);
+ my $aborted = $self->parser->parse($self, $vrdr);
+
+ kill -(POSIX::SIGKILL()) => $pid if $aborted;
 
  $self->{exit_code} = (waitpid($pid, 0) == $pid) ? $? >> 8 : 255;
 
@@ -461,11 +465,7 @@ sub suppressions {
 
 =head2 C<start>
 
-    $tvs->start(
-     action  => $action,
-     tool    => $tool,
-     command => $command,
-    );
+    $tvs->start;
 
 Starts the action and tool associated to the current run.
 It's automatically called at the beginning of L</run>.
@@ -475,16 +475,6 @@ It's automatically called at the beginning of L</run>.
 sub start {
  my $self = shift;
 
- my %args = @_;
-
- for (qw<action tool command>) {
-  my $base = 'Test::Valgrind::' . ucfirst;
-  my $value = $args{$_};
-  $self->_croak("Invalid $_") unless Scalar::Util::blessed($value)
-                                                         and $value->isa($base);
-  $self->$_($args{$_})
- }
-
  delete @{$self}{qw<last_status exit_code>};
 
  $self->tool->start($self);