From: Vincent Pit <vince@profvince.com>
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/?p=perl%2Fmodules%2FTest-Valgrind.git;a=commitdiff_plain;h=cc7a828047363ac6c6021fd0857e4748ac0e646b

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');