]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - t/80-suppressions.t
No tabs please
[perl/modules/Test-Valgrind.git] / 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 }