use strict;
use warnings;
-use base qw/Test::Valgrind::Action::Test/;
+use base qw<Test::Valgrind::Action::Test>;
my $extra_tests;
my ($self, $sess, $report) = @_;
if ($report->can('is_leak') and $report->is_leak) {
- my $tb = Test::Builder->new;
- my $data = $report->data;
- $tb->is_eq($data->{leakedbytes}, 10_000, '10_000 bytes leaked');
- $tb->is_eq($data->{leakedblocks}, 1, ' in one block');
- $tb->diag("The subsequent report was correctly caught:\n" . $report->dump)
- if ($data->{leakedbytes} || 0) == 10_000
- and ($data->{leakedblocks} || 0) == 1;
- return;
+ my $data = $report->data;
+ my @trace = map $_->[2] || '?',
+ @{$data->{stack} || []}[0 .. 3];
+ my $valid_trace = (
+ $trace[0] eq 'malloc'
+ and $trace[1] eq 'tv_leak'
+ and ($trace[2] eq 'Perl_pp_entersub' or $trace[3] eq 'Perl_pp_entersub')
+ );
+
+ if ($valid_trace) {
+ my $tb = Test::Builder->new;
+ $tb->diag("The subsequent report was correctly caught:\n" . $report->dump);
+ $tb->is_eq($data->{leakedbytes}, 10_000, '10_000 bytes leaked');
+ $tb->is_eq($data->{leakedblocks}, 1, ' in one block');
+ return;
+ }
}
$self->SUPER::report($sess, $report);