Home | History | Annotate | Download | only in tests 
      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 );
     44 
     45 # List of XML sections to be ignored.
     46 my %ignore_sections = (
     47     "<errorcounts>" => "</errorcounts>",
     48     "<suppcounts>"  => "</suppcounts>"
     49 );
     50 
     51 
     52 # If FILE matches any of the FILES return 1
     53 sub file_matches ($$) {
     54     my ($file, $files) = @_;
     55     my ($string, $qstring);
     56 
     57     foreach $string (@$files) {
     58         $qstring = quotemeta($string);
     59         return 1 if ($file =~ /$qstring/);
     60     }
     61 
     62     return 0;
     63 }
     64 
     65 
     66 my $frame_buf = "";
     67 my ($file, $lineno, $in_frame, $keep_frame, $num_discarded, $ignore_line);
     68 
     69 $in_frame = $keep_frame = $num_discarded = $ignore_line = 0;
     70 
     71 line: 
     72 while (<STDIN>) {
     73     my $line = $_;
     74     chomp($line);
     75 
     76 # Check whether we're ignoring this piece of XML..
     77     if ($ignore_line) {
     78         foreach my $tag (keys %ignore_sections) {
     79             if ($line =~ $ignore_sections{$tag}) {
     80                 print "$tag...$ignore_sections{$tag}\n";
     81                 $ignore_line = 0;
     82                 next line;
     83             }
     84         }
     85     } else {
     86         foreach my $tag (keys %ignore_sections) {
     87             if ($line =~ $tag) {
     88                 $ignore_line = 1;
     89             }
     90         }
     91     }
     92 
     93     next if ($ignore_line);
     94 
     95 # OK. This line is not to be ignored.
     96 
     97 # Massage line by applying PATTERNS.
     98     foreach my $key (keys %patterns) {
     99         if ($line =~ $key) {
    100                 $line =~ s/$1/$patterns{$key}/g;
    101         }
    102     }
    103 
    104 # Handle frames
    105     if ($in_frame) {
    106         if ($line =~ /<\/frame>/) {
    107             $frame_buf .= "$line\n";
    108 # The end of a frame
    109             if ($keep_frame) {
    110 # First: If there were any preceding frames that were discarded
    111 #        print <frame>...</frame>
    112                 if ($num_discarded) {
    113                     print "    <frame>...</frame>\n";
    114                     $num_discarded = 0;
    115                 }
    116 # Secondly: Write out the frame itself
    117                 print "$frame_buf";
    118             } else {
    119 # We don't want to write this frame
    120                 ++$num_discarded;
    121             }
    122             $in_frame = $keep_frame = 0;
    123             $file = "";
    124         } elsif ($line =~ /<file>(.*)<\/file>/) {
    125             $frame_buf .= "$line\n";
    126             $file = $1;
    127             if (file_matches($file, \@tool_files) ||
    128                 file_matches($file, \@ARGV)) {
    129                 $keep_frame = 1;
    130             }
    131         } elsif ($line =~ /<line>(.*)<\/line>/) {
    132 # This code assumes that <file> always precedes <line>
    133             $lineno = $1;
    134             if (file_matches($file, \@tool_files)) {
    135                 $line =~ s/$1/.../;
    136             }
    137             $frame_buf .= "$line\n";
    138         } else {
    139             $frame_buf .= "$line\n";
    140         }
    141     } else {
    142 # not within frame
    143         if ($line =~ /<\/stack>/) {
    144             print "    <frame>...</frame>\n" if ($num_discarded);
    145             $num_discarded = 0;
    146         }
    147         if ($line =~ /<frame>/)  {
    148             $in_frame = 1;
    149             $frame_buf = "$line\n";
    150         } else {
    151             print "$line\n";
    152         }
    153     }
    154 } 
    155 
    156 exit 0;
    157