From: Vincent Pit <vince@profvince.com>
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/?p=perl%2Fmodules%2FTest-Valgrind.git;a=commitdiff_plain;h=99ca8d993130c747948de1ae1652db18d70dc5ce

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<import> 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<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;
 
+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 {