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    my $err = $@;
  23    $dbg = 0;
  24    chomp $err;
  25    diag "XS test code not available ($err)";
  26   } else {
  27    my $ret = eval "Test::Valgrind::DEBUGGING()";
  28    $dbg = $@ ? 0 : $ret;
  29   }
  30  }
  31  if ($desc =~ /still\s+reachable/) {
  32   $passed = $a >= 9900 && $a < 10100;
  33   if ($dbg) {
  34    ok($passed, $desc);
  35   } else {
  36    TODO: {
  37     local $TODO = "Leak count may be off on non-debugging perls";
  38     ok($passed, $desc);
  39    }
  40    return 1;
  41   }
  42  } else {
  43   $passed = defined $a && $a == 0;
  44   is($a, 0, $desc);
  45  }
  46  return $passed;
  47 }
  48
  49 use lib qw{blib/archpub};
  50 eval 'use Test::Valgrind cb => \&tester';
  51 if ($@) {
  52  diag $@;
  53  plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind';
  54 } else {
  55  eval "
  56   use lib qw{blib/arch};
  57   require XSLoader;
  58   XSLoader::load('Test::Valgrind', \$Test::Valgrind::VERSION);
  59  ";
  60  unless ($@) {
  61   Test::Valgrind::leak();
  62  }
  63 }