X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FValgrind%2FAction.pm;h=b1bf352f0530f96c378b31e70608d64cdb5b4ee3;hb=f2071d95aaaa4817e91cc33530deedc8d701d44d;hp=f4a03dc1a6d655148c17af4e3f8585cae989dd35;hpb=195f0244c01e942307e13d693f196156b9263444;p=perl%2Fmodules%2FTest-Valgrind.git diff --git a/lib/Test/Valgrind/Action.pm b/lib/Test/Valgrind/Action.pm index f4a03dc..b1bf352 100644 --- a/lib/Test/Valgrind/Action.pm +++ b/lib/Test/Valgrind/Action.pm @@ -9,11 +9,11 @@ Test::Valgrind::Action - Base class for Test::Valgrind actions. =head1 VERSION -Version 1.11 +Version 1.19 =cut -our $VERSION = '1.11'; +our $VERSION = '1.19'; =head1 DESCRIPTION @@ -23,11 +23,15 @@ Actions are called each time a tool encounter an error and decide what to do wit =cut -use base qw/Test::Valgrind::Component Test::Valgrind::Carp/; +use Test::Valgrind::Util; + +use base qw; =head1 METHODS -=head2 C<< new action => $action >> +=head2 C + + my $tva = Test::Valgrind::Action->new(action => $action); Creates a new action object of type C<$action> by requiring and redispatching the method call to the module named C<$action> if it contains C<'::'> or to C otherwise. The class represented by C<$action> must inherit this class. @@ -41,11 +45,10 @@ sub new { my %args = @_; if ($class eq __PACKAGE__) { - my $action = delete $args{action} || 'Test'; - $action =~ s/[^\w:]//g; - $action = __PACKAGE__ . "::$action" if $action !~ /::/; - $class->_croak("Couldn't load action $action: $@") - unless eval "require $action; 1"; + my ($action, $msg) = Test::Valgrind::Util::validate_subclass( + $args{action} || 'Test', + ); + $class->_croak($msg) unless defined $action; return $action->new(%args); } @@ -60,13 +63,17 @@ Indicates if the action wants C to run in suppression-generating mode sub do_suppressions { 0 } -=head2 C +=head2 C + + $tva->start($session); Called when the C<$session> starts. Defaults to set L. -=head2 C +=head2 C + + $tva->report($session, $report); Invoked each time the C process attached to the C<$session> spots an error. C<$report> is a L object describing the error. @@ -83,7 +90,9 @@ sub report { return; } -=head2 C +=head2 C + + $tva->abort($session, $msg); Triggered when the C<$session> has to interrupt the action. @@ -93,13 +102,17 @@ Defaults to croak. sub abort { $_[0]->_croak($_[2]) } -=head2 C +=head2 C + + $tva->finish($session); Called when the C<$session> finishes. Defaults to clear L. -=head2 C +=head2 C + + $tva->status($session); Returns the status code corresponding to the last run of the action. @@ -139,7 +152,7 @@ You can find documentation for this module with the perldoc command. =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.