Revamp test skipping logic

[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind / Session.pm

diff --git a/lib/Test/Valgrind/Session.pm b/lib/Test/Valgrind/Session.pm
index 51fd0bde779afdb0504aadb5a6c02b1ec521e1b1..da71b7876d92ebac3d9e493936fa60b2beb6d22b 100644 (file)
--- 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 });
-
- $self->_run($args{command});
-}
+ my ($self, %args) = @_;
 
-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,7 +340,7 @@ 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): $!");
@@ -461,11 +463,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 +473,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);