From: Vincent Pit <vince@profvince.com>
Date: Tue, 14 Apr 2009 20:55:26 +0000 (+0200)
Subject: Test that the stack trace is correct in t/20-bad.t
X-Git-Tag: v1.01~1
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FTest-Valgrind.git;a=commitdiff_plain;h=b49eb32471c5c0c67b98b989484e9233e1dea06c

Test that the stack trace is correct in t/20-bad.t
---

diff --git a/t/lib/Test/Valgrind/Test/Action.pm b/t/lib/Test/Valgrind/Test/Action.pm
index 6912cbd..0ecee8f 100644
--- a/t/lib/Test/Valgrind/Test/Action.pm
+++ b/t/lib/Test/Valgrind/Test/Action.pm
@@ -29,14 +29,15 @@ sub report_smart {
  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 $trace = join ' ', map { $_->[2] } @{$report->data->{stack} || []}[0 .. 2];
+  if ($trace eq 'malloc XS_Test__Valgrind_leak Perl_pp_entersub') {
+   my $tb = Test::Builder->new;
+   $tb->diag("The subsequent report was correctly caught:\n" . $report->dump);
+   my $data = $report->data;
+   $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);