X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F80-suppressions.t;fp=t%2F80-suppressions.t;h=b9266a5f7aa351fd3ed64330b0b8e896c703a43a;hb=b41c498738a3a4ccb8742883a42e6ea5addb1afd;hp=0000000000000000000000000000000000000000;hpb=c28e54f56f6f36e3d6364b1cd07048bb288aa9d7;p=perl%2Fmodules%2FTest-Valgrind.git

diff --git a/t/80-suppressions.t b/t/80-suppressions.t
new file mode 100644
index 0000000..b9266a5
--- /dev/null
+++ b/t/80-suppressions.t
@@ -0,0 +1,55 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use Test::Valgrind::Command;
+use Test::Valgrind::Tool;
+use Test::Valgrind::Action;
+use Test::Valgrind::Session;
+
+my $cmd = Test::Valgrind::Command->new(
+ command => 'Perl',
+ args    => [ ],
+);
+
+my $tool = Test::Valgrind::Tool->new(
+ tool => 'memcheck',
+);
+
+my $sess = Test::Valgrind::Session->new(
+ min_version => $tool->requires_version,
+);
+
+$sess->command($cmd);
+$sess->tool($tool);
+
+my $file = $sess->def_supp_file;
+
+like($file, qr!\Q$Test::Valgrind::Session::VERSION\E/memcheck-\d+(?:\.\d+)*-[0-9a-f]{32}\.supp$!, 'suppression file is correctly named');
+ok(-e $file, 'suppression file exists');
+ok(-r $file, 'suppression file is readable');
+
+if (not open my $supp, '<', $file) {
+ fail("Couldn't open the suppression file at $file: $!");
+} else {
+ pass("Could open the suppression file");
+ my ($in, $count, $true, $line) = (0, 0, 0, 0);
+ while (<$supp>) {
+  ++$line;
+  chomp;
+  s/^\s*//;
+  s/\s*$//;
+  if (!$in && $_ eq '{') {
+   $in = $line;
+  } elsif ($in && $_ eq '}') {
+   ++$count;
+   ++$true if $line - $in >= 2;
+   $in = 0;
+  }
+ }
+ diag "$count suppressions, of which $true are not empty";
+ close $supp;
+}