t/80-suppressions.t

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