]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blobdiff - lib/Test/Valgrind/Command.pm
This is 1.19
[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind / Command.pm
index 75dfae9e4471ee57f8d355b5b3dc245a0842e8cd..4b046cc5a7b696b84e3545f02f23d6164df80778 100644 (file)
@@ -9,25 +9,33 @@ Test::Valgrind::Command - Base class for Test::Valgrind commands.
 
 =head1 VERSION
 
 
 =head1 VERSION
 
-Version 1.00
+Version 1.19
 
 =cut
 
 
 =cut
 
-our $VERSION = '1.00';
+our $VERSION = '1.19';
 
 =head1 DESCRIPTION
 
 This class is the base for L<Test::Valgrind> commands.
 
 
 =head1 DESCRIPTION
 
 This class is the base for L<Test::Valgrind> commands.
 
-Commands gather information about the target of the analysis. They should also provide a default setup for generating suppressions.
+Commands gather information about the target of the analysis.
+They should also provide a default setup for generating suppressions.
 
 =cut
 
 
 =cut
 
-use base qw/Test::Valgrind::Carp/;
+use Test::Valgrind::Util;
+
+use base qw<Test::Valgrind::Carp>;
 
 =head1 METHODS
 
 
 =head1 METHODS
 
-=head2 C<< new command => $command, args => \@args >>
+=head2 C<new>
+
+    my $tvc = Test::Valgrind::Command->new(
+     command => $command,
+     args    => \@args,
+    );
 
 Creates a new command object of type C<$command> by requiring and redispatching the method call to the module named C<$command> if it contains C<'::'> or to C<Test::Valgrind::Command::$command> otherwise.
 The class represented by C<$command> must inherit this class.
 
 Creates a new command object of type C<$command> by requiring and redispatching the method call to the module named C<$command> if it contains C<'::'> or to C<Test::Valgrind::Command::$command> otherwise.
 The class represented by C<$command> must inherit this class.
@@ -42,15 +50,15 @@ sub new {
 
  my %args = @_;
 
 
  my %args = @_;
 
- if ($class eq __PACKAGE__ and my $cmd = delete $args{command}) {
-  $cmd =~ s/[^\w:]//g;
-  $cmd = __PACKAGE__ . "::$cmd" if $cmd !~ /::/;
-  $class->_croak("Couldn't load command $cmd: $@") unless eval "require $cmd;1";
+ my $cmd = delete $args{command};
+ if ($class eq __PACKAGE__ and defined $cmd) {
+  ($cmd, my $msg) = Test::Valgrind::Util::validate_subclass($cmd);
+  $class->_croak($msg) unless defined $cmd;
   return $cmd->new(%args);
  }
 
  my $args = delete $args{args};
   return $cmd->new(%args);
  }
 
  my $args = delete $args{args};
- $class->_croak('Invalid argument list') unless $args and ref $args eq 'ARRAY';
+ $class->_croak('Invalid argument list') if $args and ref $args ne 'ARRAY';
 
  bless {
   args => $args,
 
  bless {
   args => $args,
@@ -67,7 +75,9 @@ Defaults to return C<undef>, which skips suppression generation.
 
 sub new_trainer { }
 
 
 sub new_trainer { }
 
-=head2 C<args $session>
+=head2 C<args>
+
+    my @args = $tvc->args($session);
 
 Returns the list of command-specific arguments that are to be passed to C<valgrind>.
 
 
 Returns the list of command-specific arguments that are to be passed to C<valgrind>.
 
@@ -77,7 +87,9 @@ Defaults to return the contents of the C<args> option.
 
 sub args { @{$_[0]->{args} || []} }
 
 
 sub args { @{$_[0]->{args} || []} }
 
-=head2 C<env $session>
+=head2 C<env>
+
+    my $env = $tvc->env($session);
 
 This event is called in scalar context before the command is ran, and the returned value goes out of scope when the analysis ends.
 It's useful for e.g. setting up C<%ENV> for the child process by returning an L<Env::Sanctify> object, hence the name.
 
 This event is called in scalar context before the command is ran, and the returned value goes out of scope when the analysis ends.
 It's useful for e.g. setting up C<%ENV> for the child process by returning an L<Env::Sanctify> object, hence the name.
@@ -88,7 +100,9 @@ Defaults to void.
 
 sub env { }
 
 
 sub env { }
 
-=head2 C<suppressions_tag $session>
+=head2 C<suppressions_tag>
+
+    my $tag = $tvc->suppressions_tag($session);
 
 Returns a identifier that will be used to pick up the right suppressions for running the command, or C<undef> to indicate that no special suppressions are needed.
 
 
 Returns a identifier that will be used to pick up the right suppressions for running the command, or C<undef> to indicate that no special suppressions are needed.
 
@@ -98,6 +112,31 @@ This method must be implemented when subclassing.
 
 sub suppressions_tag;
 
 
 sub suppressions_tag;
 
+=head2 C<check_suppressions_file>
+
+    my $supp_ok = $tvc->check_suppressions_file($file);
+
+Returns a boolean indicating whether the suppressions contained in C<$file> are compatible with the command.
+
+Defaults to true.
+
+=cut
+
+sub check_suppressions_file { 1 }
+
+=head2 C<filter>
+
+    my $filtered_report = $tvc->filter($session, $report);
+
+The C<$session> calls this method after receiving a report from the tool and before forwarding it to the action.
+You can either return a mangled C<$report> (which does not need to be a clone of the original) or C<undef> if you want the action to ignore it completely.
+
+Defaults to the identity function.
+
+=cut
+
+sub filter { $_[2] }
+
 =head1 SEE ALSO
 
 L<Test::Valgrind>, L<Test::Valgrind::Session>.
 =head1 SEE ALSO
 
 L<Test::Valgrind>, L<Test::Valgrind::Session>.
@@ -121,7 +160,7 @@ You can find documentation for this module with the perldoc command.
 
 =head1 COPYRIGHT & LICENSE
 
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2009 Vincent Pit, all rights reserved.
+Copyright 2009,2010,2011,2013,2015,2016 Vincent Pit, all rights reserved.
 
 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 
 
 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.