t/30-bad.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config qw/%Config/;
   7
   8 use Test::More;
   9
  10 my $dbg;
  11
  12 sub tester {
  13  my ($a, $desc) = @_;
  14  my $passed;
  15  if (!defined $dbg) {
  16   eval "
  17    use lib qw{blib/arch};
  18    require XSLoader;
  19    XSLoader::load('Test::Valgrind', \$Test::Valgrind::VERSION);
  20   ";
  21   if ($@) {
  22    $dbg = 0;
  23   } else {
  24    my $ret = eval "Test::Valgrind::DEBUGGING()";
  25    $dbg = $@ ? 0 : $ret;
  26   }
  27  }
  28  if ($desc =~ /still\s+reachable/) {
  29   $passed = $a >= 9900 && $a < 10100;
  30   if ($dbg) {
  31    ok($passed, $desc);
  32   } else {
  33    TODO: {
  34     local $TODO = "Leak count may be off on non-debugging perls";
  35     ok($passed, $desc);
  36    }
  37    return 1;
  38   }
  39  } else {
  40   $passed = defined $a && $a == 0;
  41   is($a, 0, $desc);
  42  }
  43  return $passed;
  44 }
  45
  46 use lib qw{blib/archpub};
  47 eval 'use Test::Valgrind cb => \&tester';
  48 if ($@) {
  49  diag $@;
  50  plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind';
  51 } else {
  52  eval "
  53   use lib qw{blib/arch};
  54   require XSLoader;
  55   XSLoader::load('Test::Valgrind', \$Test::Valgrind::VERSION);
  56  ";
  57  if ($@) {
  58   diag $@;
  59   plan skip_all => "XS test code not available";
  60  } else {
  61   Test::Valgrind::leak();
  62  }
  63 }