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 a9f0eff0cf9a6a7119fc6d7ea849ef95a8124bef..9477f34932e60d88e7692843dd53261b55349b3c 100644 (file)
--- 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 8b41a68d6239bff23f9c0b5dc196a8312fcd3c25..369a92155aa2cb5c4a74dbadb78ea38690ece7a6 100644 (file)
--- 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');