helgrind/tests/filter_xml

   1 #!/usr/bin/env perl
   2
   3 #---------------------------------------------------------------------
   4 # Quick and dirty program to filter helgrind's XML output.
   5 #
   6 # The script works line-by-line and is generally unaware of XML structure
   7 # and does not bother with issues of well-formedness.
   8 #
   9 # Consists of two parts
  10 # (1) Global match and replace (see PATTERNS below)
  11 # (2) Removal of stack frames
  12 #     Stack frames whose associated file name does not match any name in
  13 #     TOOL_FILES or in the list of files given on the command line
  14 #     will be discarded. For a sequence of one or more discarded frames
  15 #     a line   <frame>...</frame> will be inserted.
  16 #
  17 #---------------------------------------------------------------------
  18
  19 use warnings;
  20 use strict;
  21
  22 #---------------------------------------------------------------------
  23 # A list of files specific to the tool at hand. Line numbers in
  24 # these files will be removed from stack frames matching these files.
  25 #---------------------------------------------------------------------
  26 my @tool_files = ( "hg_intercepts.c", "vg_replace_malloc.c" );
  27
  28 # List of patterns and replacement strings.
  29 # Each pattern must identify a substring which will be replaced.
  30 my %patterns = (
  31     "<pid>(.*)</pid>"       => "...",
  32     "<ppid>(.*)</ppid>"     => "...",
  33     "<time>(.*)</time>"     => "...",
  34     "<obj>(.*)</obj>"       => "...",
  35     "<dir>(.*)</dir>"       => "...",
  36     "<exe>(.*)</exe>"       => "...",
  37     "<tid>(.*)</tid>"       => "...",
  38     "<unique>(.*)</unique>" => "...",
  39     "thread #([0-9]+)"      => "x",
  40     "0x([0-9a-zA-Z]+)"      => "........",
  41     "Using Valgrind-([^\\s]*)"    => "X.Y.X",
  42     "Copyright \\(C\\) ([0-9]{4}-[0-9]{4}).*" => "XXXX-YYYY",
  43     '<fn>pthread_.*(@\*)</fn>'  => ""
  44 );
  45
  46 # List of XML sections to be ignored.
  47 my %ignore_sections = (
  48     "<errorcounts>" => "</errorcounts>",
  49     "<suppcounts>"  => "</suppcounts>",
  50     "pthread_create_WRK</fn>" => "<obj>"
  51 );
  52
  53 # List of XML sections to be quietly ignored.
  54 my %quiet_ignore_sections = (
  55     "pthread_create_WRK</fn>" => "<obj>"
  56 );
  57
  58
  59 # If FILE matches any of the FILES return 1
  60 sub file_matches ($$) {
  61     my ($file, $files) = @_;
  62     my ($string, $qstring);
  63
  64     foreach $string (@$files) {
  65         $qstring = quotemeta($string);
  66         return 1 if ($file =~ /$qstring/);
  67     }
  68
  69     return 0;
  70 }
  71
  72
  73 my $frame_buf = "";
  74 my ($file, $lineno, $in_frame, $keep_frame, $num_discarded, $ignore_line, $quiet_ignore_line);
  75
  76 $in_frame = $keep_frame = $num_discarded = $ignore_line = $quiet_ignore_line = 0;
  77
  78 line:
  79 while (<STDIN>) {
  80     my $line = $_;
  81     chomp($line);
  82
  83 # Check whether we're ignoring this piece of XML..
  84     if ($ignore_line) {
  85         foreach my $tag (keys %ignore_sections) {
  86             if ($line =~ $ignore_sections{$tag}) {
  87                 if ($quiet_ignore_line == 0) {
  88                     print "$tag...$ignore_sections{$tag}\n";
  89                 }
  90                 $ignore_line = 0;
  91                 $quiet_ignore_line = 0;
  92                 next line;
  93             }
  94         }
  95     } else {
  96         foreach my $tag (keys %ignore_sections) {
  97             if ($line =~ $tag) {
  98                 $ignore_line = 1;
  99             }
 100         }
 101         # Determine if this section is also in the quiet list.
 102         foreach my $tag (keys %quiet_ignore_sections) {
 103             if ($line =~ $tag) {
 104                 $quiet_ignore_line = 1;
 105             }
 106         }
 107     }
 108
 109     next if ($ignore_line);
 110
 111 # OK. This line is not to be ignored.
 112
 113 # Massage line by applying PATTERNS.
 114     foreach my $key (keys %patterns) {
 115         if ($line =~ $key) {
 116            my $matched = quotemeta($1);
 117            $line =~ s/$matched/$patterns{$key}/g;
 118         }
 119     }
 120
 121 # Handle frames
 122     if ($in_frame) {
 123         if ($line =~ /<\/frame>/) {
 124             $frame_buf .= "$line\n";
 125 # The end of a frame
 126             if ($keep_frame) {
 127 # First: If there were any preceding frames that were discarded
 128 #        print <frame>...</frame>
 129                 if ($num_discarded) {
 130                     print "    <frame>...</frame>\n";
 131                     $num_discarded = 0;
 132                 }
 133 # Secondly: Write out the frame itself
 134                 print "$frame_buf";
 135             } else {
 136 # We don't want to write this frame
 137                 ++$num_discarded;
 138             }
 139             $in_frame = $keep_frame = 0;
 140             $file = "";
 141         } elsif ($line =~ /<file>(.*)<\/file>/) {
 142             $frame_buf .= "$line\n";
 143             $file = $1;
 144             if (file_matches($file, \@tool_files) ||
 145                 file_matches($file, \@ARGV)) {
 146                 $keep_frame = 1;
 147             }
 148         } elsif ($line =~ /<line>(.*)<\/line>/) {
 149 # This code assumes that <file> always precedes <line>
 150             $lineno = $1;
 151             if (file_matches($file, \@tool_files)) {
 152                 $line =~ s/$1/.../;
 153             }
 154             $frame_buf .= "$line\n";
 155         } else {
 156             $frame_buf .= "$line\n";
 157         }
 158     } else {
 159 # not within frame
 160         if ($line =~ /<\/stack>/) {
 161             print "    <frame>...</frame>\n" if ($num_discarded);
 162             $num_discarded = 0;
 163         }
 164         if ($line =~ /<frame>/)  {
 165             $in_frame = 1;
 166             $frame_buf = "$line\n";
 167         } else {
 168             print "$line\n";
 169         }
 170     }
 171 }
 172
 173 exit 0;