X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FTest-Valgrind.git;a=blobdiff_plain;f=lib%2FTest%2FValgrind%2FCommand%2FPerl.pm;h=939e1ccc86f9f66d13b058a01d5ff78c3802c564;hp=55c8babe5bb48e99eace1bf5148dd600cd756900;hb=a08a925178ff4a5e8a68dc9ecc21d50c67049939;hpb=139a661cde3aaf5fbf8883f35c0acaf77b8205ab

diff --git a/lib/Test/Valgrind/Command/Perl.pm b/lib/Test/Valgrind/Command/Perl.pm
index 55c8bab..939e1cc 100644
--- a/lib/Test/Valgrind/Command/Perl.pm
+++ b/lib/Test/Valgrind/Command/Perl.pm
@@ -22,6 +22,7 @@ It handles the suppression generation and sets the main command-line flags.
 
 =cut
 
+use List::Util    ();
 use Env::Sanctify ();
 
 use Test::Valgrind::Suppressions;
@@ -194,7 +195,8 @@ sub check_suppressions_file {
 
   local $_;
   while (<$fh>) {
-   return 1 if /^\s*fun:Perl_/;
+   return 1 if /^\s*fun:(Perl|S|XS)_/
+            or /^\s*obj:.*perl/;
   }
 
   close $fh;
@@ -209,9 +211,40 @@ sub filter {
  return $report if $report->is_diag
                 or not $report->isa('Test::Valgrind::Report::Suppressions');
 
- my $data = $report->data;
- $data =~ s/[^\r\n]*\bPerl_runops_(?:standard|debug)\b.*//s;
- $data = Test::Valgrind::Suppressions->strip_tail($session, $data);
+ my @frames = grep length, split /\n/, $report->data;
+
+ # If we see the runloop, match from here.
+ my $top = List::Util::first(sub {
+  $frames[$_] =~ /^\s*fun:Perl_runops_(?:standard|debug)\b/
+ }, 0 .. $#frames);
+ --$top if $top;
+
+ unless (defined $top) {
+  # Otherwise, match from the latest Perl_ symbol.
+  $top = List::Util::first(sub {
+   $frames[$_] =~ /^\s*fun:Perl_/
+  }, reverse 0 .. $#frames);
+ }
+
+ unless (defined $top) {
+  # Otherwise, match from the latest S_ symbol.
+  $top = List::Util::first(sub {
+   $frames[$_] =~ /^\s*fun:S_/
+  }, reverse 0 .. $#frames);
+ }
+
+ unless (defined $top) {
+  # Otherwise, match from the latest XS_ symbol.
+  $top = List::Util::first(sub {
+   $frames[$_] =~ /^\s*fun:XS_/
+  }, reverse 0 .. $#frames);
+ }
+
+ $#frames = $top if defined $top;
+
+ my $data = join "\n", @frames, '';
+
+ $data = Test::Valgrind::Suppressions->maybe_generalize($session, $data);
 
  $report->new(
   id   => $report->id,