]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blobdiff - lib/Test/Valgrind/Parser/Suppressions/Text.pm
This is 1.17
[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind / Parser / Suppressions / Text.pm
index 6142e4278d01b484eb7bcb0a24ed0fd88d3b3a22..90cbea9aa22945a66dbb63d035c85bdf0a60d7dd 100644 (file)
@@ -1,59 +1,42 @@
-package Test::Valgrind::Tool::SuppressionsParser;
+package Test::Valgrind::Parser::Suppressions::Text;
 
 use strict;
 use warnings;
 
 =head1 NAME
 
 
 use strict;
 use warnings;
 
 =head1 NAME
 
-Test::Valgrind::Tool::SuppressionsParser - Mock Test::Valgrind::Tool for parsing valgrind suppressions.
+Test::Valgrind::Parser::Suppressions::Text - Parse valgrind suppressions output as text blocks.
 
 =head1 VERSION
 
 
 =head1 VERSION
 
-Version 1.02
+Version 1.17
 
 =cut
 
 
 =cut
 
-our $VERSION = '1.02';
+our $VERSION = '1.17';
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 
-This class provides a default C<parse_suppressions> method, so that real tools for which suppressions are meaningful can exploit it by inheriting.
-
-It's not meant to be used directly as a tool.
+This is a L<Test::Valgrind::Parser::Text> object that can extract suppressions from C<valgrind>'s text output.
 
 =cut
 
 
 =cut
 
-use base qw/Test::Valgrind::Carp/;
-
-=head1 METHODS
-
-=head2 C<new>
-
-Just a croaking stub to remind you not to use this class as a real tool.
+use Test::Valgrind::Suppressions;
 
 
-If your tool both inherit from this class and from C<Test::Valgrind::Tool>, and that you want to dispatch the call to your C<new> to its ancestors', be careful with C<SUPER> which may end up calling this dieing version of C<new>.
-The solution is to either put C<Test::Valgrind::Tool> first in the C<@ISA> list or to explicitely call C<Test::Valgrind::Tool::new> instead of C<SUPER::new>.
+use base qw<Test::Valgrind::Parser::Text Test::Valgrind::Carp>;
 
 
-=cut
-
-sub new { shift->_croak('This mock tool isn\'t meant to be used directly') }
+=head1 METHODS
 
 
-=head2 C<report_class_suppressions $session>
+=head2 C<report_class>
 
 Generated reports are C<Test::Valgrind::Report::Suppressions> objects.
 Their C<data> member contains the raw text of the suppression.
 
 =cut
 
 
 Generated reports are C<Test::Valgrind::Report::Suppressions> objects.
 Their C<data> member contains the raw text of the suppression.
 
 =cut
 
-sub report_class_suppressions { 'Test::Valgrind::Report::Suppressions' }
-
-=head2 C<parse_suppressions $session, $fh>
+sub report_class { 'Test::Valgrind::Report::Suppressions' }
 
 
-Parses the filehandle C<$fh> fed with the output of F<valgrind --gen-suppressions=all> and sends a report to the session C<$session> for each suppression.
-
-=cut
-
-sub parse_suppressions {
+sub parse {
  my ($self, $sess, $fh) = @_;
 
  my ($s, $in) = ('', 0);
  my ($self, $sess, $fh) = @_;
 
  my ($s, $in) = ('', 0);
@@ -62,8 +45,13 @@ sub parse_suppressions {
  while (<$fh>) {
   s/^\s*#\s//;        # Strip comments
 
  while (<$fh>) {
   s/^\s*#\s//;        # Strip comments
 
-  next if /^==/;      # Valgrind info line
-  next if /valgrind/; # and /\Q$file\E/;
+  if (/^==/) {        # Valgrind info line
+   if (/Signal 11 being dropped from thread/) {
+    # This might loop endlessly
+    return 1;
+   }
+   next;
+  }
 
   s/^\s*//;           # Strip leading spaces
   s/<[^>]+>//;        # Strip tags
 
   s/^\s*//;           # Strip leading spaces
   s/<[^>]+>//;        # Strip tags
@@ -73,18 +61,18 @@ sub parse_suppressions {
   if ($_ eq '{') {      # A suppression block begins
    $in = 1;
   } elsif ($_ eq '}') { # A suppression block ends
   if ($_ eq '{') {      # A suppression block begins
    $in = 1;
   } elsif ($_ eq '}') { # A suppression block ends
-   # With valgrind 3.4.0, we can replace unknown series of frames by '...'
-   if ($sess->version ge '3.4.0') {
-    my $unknown_tail;
-    ++$unknown_tail while $s =~ s/(\n)\s*obj:\*\s*$/$1/;
-    $s .= "...\n" if $unknown_tail;
-   }
-
    push @supps, $s;     # Add the suppression that just ended to the list
    $s  = '';            # Reset the state
    $in = 0;
   } elsif ($in) {       # We're inside a suppresion block
    push @supps, $s;     # Add the suppression that just ended to the list
    $s  = '';            # Reset the state
    $in = 0;
   } elsif ($in) {       # We're inside a suppresion block
-   $s .= "$_\n";        # Append the current line to the state
+   if (/^fun\s*:\s*(.*)/) {
+    # Sometimes valgrind seems to forget to Z-demangle the symbol names.
+    # Make sure it's done and append the result to the state.
+    my $sym = $1;
+    $s .= 'fun:' . Test::Valgrind::Suppressions->maybe_z_demangle($sym) . "\n";
+   } else {
+    $s .= "$_\n";
+   }
   }
  }
 
   }
  }
 
@@ -96,11 +84,11 @@ sub parse_suppressions {
 
    my %call; # Frames to append (if the value is 1) or to prepend (if it's 0)
    if ($t eq 'm') {       # malloc can also be called by calloc or realloc
 
    my %call; # Frames to append (if the value is 1) or to prepend (if it's 0)
    if ($t eq 'm') {       # malloc can also be called by calloc or realloc
-    $call{$_} = 1 for qw/calloc realloc/;
+    $call{$_} = 1 for qw<calloc realloc>;
    } elsif ($t eq 're') { # realloc can also call malloc or free
    } elsif ($t eq 're') { # realloc can also call malloc or free
-    $call{$_} = 0 for qw/malloc free/;
+    $call{$_} = 0 for qw<malloc free>;
    } elsif ($t eq 'c') {  # calloc can also call malloc
    } elsif ($t eq 'c') {  # calloc can also call malloc
-    $call{$_} = 0 for qw/malloc/;
+    $call{$_} = 0 for qw<malloc>;
    }
 
    my $c = $_;
    }
 
    my $c = $_;
@@ -120,11 +108,13 @@ sub parse_suppressions {
   kind => 'Suppression',
   data => $_,
  )) for @supps, @extra;
   kind => 'Suppression',
   data => $_,
  )) for @supps, @extra;
+
+ return 0;
 }
 
 =head1 SEE ALSO
 
 }
 
 =head1 SEE ALSO
 
-L<Test::Valgrind>, L<Test::Valgrind::Tool>.
+L<Test::Valgrind>, L<Test::Valgrind::Parser::Text>.
 
 =head1 AUTHOR
 
 
 =head1 AUTHOR
 
@@ -141,21 +131,21 @@ I will be notified, and then you'll automatically be notified of progress on you
 
 You can find documentation for this module with the perldoc command.
 
 
 You can find documentation for this module with the perldoc command.
 
-    perldoc Test::Valgrind::Tool::SuppressionsParser
+    perldoc Test::Valgrind::Parser::Suppressions::Text
 
 =head1 COPYRIGHT & LICENSE
 
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2009 Vincent Pit, all rights reserved.
+Copyright 2009,2010,2011,2013,2015 Vincent Pit, all rights reserved.
 
 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 
 =cut
 
 
 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 
 =cut
 
-# End of Test::Valgrind::Tool::SuppressionsParser
+# End of Test::Valgrind::Parser::Suppressions::Text
 
 package Test::Valgrind::Report::Suppressions;
 
 
 package Test::Valgrind::Report::Suppressions;
 
-use base qw/Test::Valgrind::Report/;
+use base qw<Test::Valgrind::Report>;
 
 sub kinds { shift->SUPER::kinds(), 'Suppression' }
 
 
 sub kinds { shift->SUPER::kinds(), 'Suppression' }