use Test::Valgrind::Tool;
use Test::Valgrind::Session;
+use lib 't/lib';
+use Test::Valgrind::FakeValgrind;
+
my $cmd = Test::Valgrind::Command->new(
command => 'Perl',
- args => [ ],
+ args => [ '-e1' ],
);
-my $tool = Test::Valgrind::Tool->new(
- tool => 'memcheck',
-);
+{
+ package Test::Valgrind::Parser::Dummy;
+
+ use base 'Test::Valgrind::Parser';
+
+ sub parse { }
+}
+
+{
+ package Test::Valgrind::Tool::Dummy;
+
+ use base 'Test::Valgrind::Tool::memcheck';
+
+ sub parser_class { 'Test::Valgrind::Parser::Dummy' }
+}
+
+my $tool = Test::Valgrind::Tool::Dummy->new();
+
+{
+ package Test::Valgrind::Action::Dummy;
+
+ use base 'Test::Valgrind::Action';
+
+ sub do_suppressions { 0 }
+
+ sub report {
+ my ($self, $sess, $report) = @_;
+
+ if ($report->is_diag) {
+ my $contents = $report->data;
+ if ($contents !~ /^(?:Using valgrind |No suppressions used)/) {
+ ::diag($contents);
+ }
+ return;
+ } else {
+ $self->SUPER::report($sess, $report);
+ }
+ }
+}
+
+my $dummy_action = Test::Valgrind::Action::Dummy->new();
my $sess = eval { Test::Valgrind::Session->new(
min_version => $tool->requires_version,
) };
-if ($@) {
- plan skip_all => $@;
+if (my $err = $@) {
+ $err =~ s/^(Empty valgrind candidates list|No appropriate valgrind executable could be found)\s+at.*/$1/;
+ plan skip_all => $err;
} else {
plan tests => 4;
}
$sess->command($cmd);
$sess->tool($tool);
-my $file = $sess->def_supp_file;
+my $file = $sess->def_supp_file;
+my $VERSION = quotemeta $Test::Valgrind::Session::VERSION;
+my $exp = qr!$VERSION/memcheck-\d+(?:\.\d+)*-[0-9a-f]{32}\.supp$!;
+like $file, $exp, 'default suppression file is correctly named';
-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');
+my $res = open my $supp_fh, '<', $file;
+my $err = $!;
+ok $res, 'default suppression file can be opened';
+diag "open($file): $err" unless $res;
-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;
+if ($res) {
+ my ($count, $non_empty, $perl_related) = (0, 0, 0);
+ my ($in, $valid_frames, $seen_perl);
+ while (<$supp_fh>) {
chomp;
s/^\s*//;
s/\s*$//;
if (!$in && $_ eq '{') {
- $in = $line;
- } elsif ($in && $_ eq '}') {
- ++$count;
- ++$true if $line - $in >= 2;
- $in = 0;
+ $in = 1;
+ $valid_frames = 0;
+ $seen_perl = 0;
+ } elsif ($in) {
+ if ($_ eq '}') {
+ ++$count;
+ ++$non_empty if $valid_frames;
+ ++$perl_related if $seen_perl;
+ $in = 0;
+ } else {
+ ++$valid_frames if /^\s*fun:/;
+ ++$seen_perl if /^\s*fun:Perl_/;
+ }
}
}
- diag "$count suppressions, of which $true are not empty";
- close $supp;
+ diag "The default suppression file contains $count suppressions, of which $non_empty are not empty and $perl_related apply to perl";
+ close $supp_fh;
+}
+
+SKIP: {
+ my $dummy_vg = Test::Valgrind::FakeValgrind->new();
+ skip $dummy_vg => 2 unless ref $dummy_vg;
+
+ eval { Test::Valgrind::Session->new(
+ valgrind => $dummy_vg->path,
+ no_def_supp => 1,
+ extra_supp => [ 't/supp/no_perl' ],
+ )->run(
+ tool => $tool,
+ command => $cmd,
+ action => $dummy_action,
+ ) };
+ like $@, qr/No compatible suppressions available/,
+ 'incompatible suppression file';
+
+ eval { Test::Valgrind::Session->new(
+ valgrind => $dummy_vg->path,
+ no_def_supp => 1,
+ allow_no_supp => 1,
+ extra_supp => [ 't/supp/no_perl' ],
+ )->run(
+ tool => $tool,
+ command => $cmd,
+ action => $dummy_action,
+ ) };
+ is $@, '', 'incompatible suppression file, but forced';
}