From: Vincent Pit Date: Thu, 8 Sep 2011 10:17:28 +0000 (+0200) Subject: Make the stack trace test of t/20-bad.t more predictable X-Git-Tag: rt88074~2 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=cc7a828047363ac6c6021fd0857e4748ac0e646b;p=perl%2Fmodules%2FTest-Valgrind.git Make the stack trace test of t/20-bad.t more predictable Since recently, the XSUBs can be declared static, so they may not appear in the stack trace when optimizations are on. Work around this by leaking the test memory from a function that can't be inlined. --- diff --git a/Valgrind.xs b/Valgrind.xs index a9f0eff..9477f34 100644 --- a/Valgrind.xs +++ b/Valgrind.xs @@ -18,6 +18,12 @@ const char *tv_leaky = NULL; +extern void tv_leak(void) { + tv_leaky = malloc(10000); + + return; +} + /* --- XS ------------------------------------------------------------------ */ MODULE = Test::Valgrind PACKAGE = Test::Valgrind @@ -33,7 +39,7 @@ BOOT: void leak() CODE: - tv_leaky = malloc(10000); + tv_leak(); XSRETURN_UNDEF; SV * diff --git a/t/lib/Test/Valgrind/Test/Action.pm b/t/lib/Test/Valgrind/Test/Action.pm index 8b41a68..369a921 100644 --- a/t/lib/Test/Valgrind/Test/Action.pm +++ b/t/lib/Test/Valgrind/Test/Action.pm @@ -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');