X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2Flib%2FTest%2FValgrind%2FTest%2FAction.pm;h=369a92155aa2cb5c4a74dbadb78ea38690ece7a6;hb=cc7a828047363ac6c6021fd0857e4748ac0e646b;hp=0b409400df761198bcd18820e02661d11b1b3196;hpb=b6d864328dca14ce16a994f974546a76a7097665;p=perl%2Fmodules%2FTest-Valgrind.git diff --git a/t/lib/Test/Valgrind/Test/Action.pm b/t/lib/Test/Valgrind/Test/Action.pm index 0b40940..369a921 100644 --- a/t/lib/Test/Valgrind/Test/Action.pm +++ b/t/lib/Test/Valgrind/Test/Action.pm @@ -3,7 +3,7 @@ package Test::Valgrind::Test::Action; use strict; use warnings; -use base qw/Test::Valgrind::Action::Test/; +use base qw; my $extra_tests; @@ -30,8 +30,15 @@ sub report_smart { if ($report->can('is_leak') and $report->is_leak) { my $data = $report->data; - my $trace = join ' ', map { $_->[2] } @{$data->{stack} || []}[0 .. 2]; - if ($trace eq 'malloc XS_Test__Valgrind_leak Perl_pp_entersub') { + 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');