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 ($num, $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 =~ /definitely\s+lost/) {
  30   $passed = $num >= 9900 && $num < 10100;
  31   if ($dbg) {
  32    ok($passed, $desc);
  33    diag "    Got $num instead of 0." unless $passed;
  34   } else {
  35    TODO: {
  36     local $TODO = "Leak count may be off on non-debugging perls";
  37     ok($passed, $desc);
  38    }
  39    $passed = 1;
  40   }
  41  } else {
  42   $passed = defined $num && $num == 0;
  43   is($num, 0, $desc);
  44  }
  45  return $passed;
  46 }
  47
  48 use lib qw{blib/archpub};
  49 eval 'use Test::Valgrind cb => \&tester';
  50 if ($@) {
  51  diag $@;
  52  plan skip_all => 'Test::Valgrind is required to run test your distribution with valgrind';
  53 } else {
  54  eval "
  55   use lib qw{blib/arch};
  56   require XSLoader;
  57   XSLoader::load('Test::Valgrind', \$Test::Valgrind::VERSION);
  58  ";
  59  unless ($@) {
  60   Test::Valgrind::leak();
  61  }
  62 }