From: Vincent Pit Date: Mon, 25 Aug 2008 21:22:44 +0000 (+0200) Subject: Add the cb option X-Git-Tag: v0.05~3 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=99ca8d993130c747948de1ae1652db18d70dc5ce;p=perl%2Fmodules%2FTest-Valgrind.git Add the cb option --- diff --git a/lib/Test/Valgrind.pm b/lib/Test/Valgrind.pm index 838a3ae..fa79775 100644 --- a/lib/Test/Valgrind.pm +++ b/lib/Test/Valgrind.pm @@ -45,36 +45,68 @@ You can pass parameters to C as a list of key / value pairs, where valid =over 4 -=item C<< supp => $file >> +=item * + +C<< supp => $file >> Also use suppressions from C<$file> besides perl's. -=item C<< no_supp => $bool >> +=item * + +C<< no_supp => $bool >> If true, do not use any suppressions. -=item C<< callers => $number >> +=item * + +C<< callers => $number >> Specify the maximum stack depth studied when valgrind encounters an error. Raising this number improves granularity. Default is 12. -=item C<< extra => [ @args ] >> +=item * + +C<< extra => [ @args ] >> Add C<@args> to valgrind parameters. -=item C<< diag => $bool >> +=item * + +C<< diag => $bool >> If true, print the raw output of valgrind as diagnostics (may be quite verbose). -=item C<< no_test => $bool >> +=item * + +C<< no_test => $bool >> If true, do not actually output the plan and the tests results. +=item * + +C<< cb => sub { my ($val, $name) = @_; ...; return $passed } >> + +Specifies a subroutine to execute for each test instead of C. It receives the number of bytes leaked in C<$_[0]> and the test name in C<$_[1]>, and is expected to return true if the test passed and false otherwise. Defaults to + + sub { + is($_[0], 0, $_[1]); + (defined $_[0] and $_[0] == 0) : 1 : 0 + } + =back =cut my $run; +sub _counter { + (defined $_[0] and $_[0] == 0) ? 1 : 0; +} + +sub _tester { + is($_[0], 0, $_[1]); + _counter(@_); +} + sub import { shift; croak 'Optional arguments must be passed as key => value pairs' if @_ % 2; @@ -163,10 +195,11 @@ sub import { } } waitpid $pid, 0; - my $failed = 0; + my $failed = 5; + my $cb = ($args{no_test} ? \&_counter + : ($args{cb} ? $args{cb} : \&_tester)); for (@tests) { - is($res{$_}, 0, 'valgrind ' . $_) unless $args{no_test}; - ++$failed if defined $res{$_} and $res{$_} != 0; + $failed -= $cb->($res{$_}, 'valgrind ' . $_) ? 1 : 0; } exit $failed; } else {