t/80-suppressions.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use Test::Valgrind::Command;
   9 use Test::Valgrind::Tool;
  10 use Test::Valgrind::Session;
  11
  12 my $cmd = Test::Valgrind::Command->new(
  13  command => 'Perl',
  14  args    => [ ],
  15 );
  16
  17 my $tool = Test::Valgrind::Tool->new(
  18  tool => 'memcheck',
  19 );
  20
  21 my $sess = eval { Test::Valgrind::Session->new(
  22  min_version => $tool->requires_version,
  23 ) };
  24
  25 if (my $err = $@) {
  26  $err =~ s/^(Empty valgrind candidates list|No appropriate valgrind executable could be found)\s+at.*/$1/;
  27  plan skip_all => $err;
  28 } else {
  29  plan tests => 4;
  30 }
  31
  32 $sess->command($cmd);
  33 $sess->tool($tool);
  34
  35 my $file = $sess->def_supp_file;
  36
  37 like($file, qr!\Q$Test::Valgrind::Session::VERSION\E/memcheck-\d+(?:\.\d+)*-[0-9a-f]{32}\.supp$!, 'suppression file is correctly named');
  38 ok(-e $file, 'suppression file exists');
  39 ok(-r $file, 'suppression file is readable');
  40
  41 if (not open my $supp, '<', $file) {
  42  fail("Couldn't open the suppression file at $file: $!");
  43 } else {
  44  pass("Could open the suppression file");
  45  my ($in, $count, $true, $line) = (0, 0, 0, 0);
  46  while (<$supp>) {
  47   ++$line;
  48   chomp;
  49   s/^\s*//;
  50   s/\s*$//;
  51   if (!$in && $_ eq '{') {
  52    $in = $line;
  53   } elsif ($in && $_ eq '}') {
  54    ++$count;
  55    ++$true if $line - $in >= 2;
  56    $in = 0;
  57   }
  58  }
  59  diag "$count suppressions, of which $true are not empty";
  60  close $supp;
  61 }