=head1 VERSION
-Version 1.15
+Version 1.17
=cut
-our $VERSION = '1.15';
+our $VERSION = '1.17';
=head1 DESCRIPTION
=cut
+use List::Util ();
use Env::Sanctify ();
use Test::Valgrind::Suppressions;
local $_;
while (<$fh>) {
- return 1 if /^\s*fun:Perl_/;
+ return 1 if /^\s*fun:(Perl|S|XS)_/
+ or /^\s*obj:.*perl/;
}
close $fh;
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,