helgrind/tests/filter_helgrind

   1 #!/usr/bin/env perl
   2
   3 use warnings;
   4 use strict;
   5
   6 #---------------------------------------------------------------------
   7 # A list of files specific to the tool at hand. Line numbers in
   8 # these files will be removed from backtrace entries matching these files.
   9 #---------------------------------------------------------------------
  10 my @tool_files = ( "hg_intercepts.c", "vg_replace_malloc.c" );
  11
  12
  13 sub massage_backtrace_line ($$$) {
  14     my ($line, $tool_files, $cmdlin_files) = @_;
  15     my ($string, $qstring);
  16
  17 # If LINE matches any of the file names passed on the command line
  18 # (i.e. in CMDLIN_FILES) return LINE unmodified.
  19
  20     foreach $string (@$cmdlin_files) {
  21         $qstring = quotemeta($string);
  22         return $line if ($line =~ /$qstring/);
  23     }
  24
  25 # If LINE matches any of the file names in TOOL_FILES remove the line
  26 # number and return the so modified line.
  27
  28     foreach $string (@$tool_files) {
  29         $qstring = quotemeta($string);
  30         return $line if ($line =~ s/$qstring:[0-9]+/$string:.../m);
  31 # Special case for functions whose line numbers have been removed in
  32 # filter_stderr_basic. FIXME: filter_stderr_basic should not do that.
  33         return $line if ($line =~ s/$qstring:\.\.\./$string:.../m);
  34     }
  35
  36 # Did not match anything
  37     $line =~ s/[\w]+.*/.../m;
  38
  39     return "$line";
  40 }
  41
  42
  43 #---------------------------------------------------------------------
  44 # Process lines. Two categories
  45 # (a) lines from back traces
  46 #     pass through those lines that contain file names we're interested in
  47 # (b) everything else
  48 #     pass through as is
  49 #---------------------------------------------------------------------
  50 my $prev_line = "";
  51 while (<STDIN>) {
  52     my $line = $_;
  53     chomp($line);
  54     if ($line =~ /^\s+(at |by )/)  {   # lines in a back trace
  55         $line = massage_backtrace_line($line, \@tool_files, \@ARGV);
  56         if ($line =~ /\s+\.\.\./) {
  57             print "$line\n" if ($prev_line !~ /\s+\.\.\./);
  58         } else {
  59             print "$line\n";
  60         }
  61     } else {
  62         print "$line\n";  # everything else
  63     }
  64     $prev_line = $line
  65 }
  66
  67 exit 0;