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