t/30-bad.t

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