Add the cb option

diff --git a/lib/Test/Valgrind.pm b/lib/Test/Valgrind.pm
index 838a3ae777223ad0952cf5862de84a7d8d37b399..fa79775c2efb2be24be053fc42c19e09e822de5f 100644 (file)
--- a/lib/Test/Valgrind.pm
+++ b/lib/Test/Valgrind.pm
@@ -45,36 +45,68 @@ You can pass parameters to C<import> as a list of key / value pairs, where valid
 
 =over 4
 
 
 =over 4
 

-=item C<< supp => $file >>
+=item *
+
+C<< supp => $file >>

 
 Also use suppressions from C<$file> besides perl's.
 
 
 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.
 
 
 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.
 
 
 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.
 
 
 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).
 
 
 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.
 
 
 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<Test::More::is>. 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;
 
 =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;
 sub import {
  shift;
  croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;


@@ -163,10 +195,11 @@ sub import {
    }
   }
   waitpid $pid, 0;
    }
   }
   waitpid $pid, 0;

-  my $failed = 0;
+  my $failed = 5;
+  my $cb = ($args{no_test} ? \&_counter
+                           : ($args{cb} ? $args{cb} : \&_tester));

   for (@tests) {
   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 {
   }
   exit $failed;
  } else {