| #!/usr/bin/env perl |
| |
| #--------------------------------------------------------------------- |
| # Quick and dirty program to filter helgrind's XML output. |
| # |
| # The script works line-by-line and is generally unaware of XML structure |
| # and does not bother with issues of well-formedness. |
| # |
| # Consists of two parts |
| # (1) Global match and replace (see PATTERNS below) |
| # (2) Removal of stack frames |
| # Stack frames whose associated file name does not match any name in |
| # TOOL_FILES or in the list of files given on the command line |
| # will be discarded. For a sequence of one or more discarded frames |
| # a line <frame>...</frame> will be inserted. |
| # |
| #--------------------------------------------------------------------- |
| |
| use warnings; |
| use strict; |
| |
| #--------------------------------------------------------------------- |
| # A list of files specific to the tool at hand. Line numbers in |
| # these files will be removed from stack frames matching these files. |
| #--------------------------------------------------------------------- |
| my @tool_files = ( "hg_intercepts.c", "vg_replace_malloc.c" ); |
| |
| # List of patterns and replacement strings. |
| # Each pattern must identify a substring which will be replaced. |
| my %patterns = ( |
| "<pid>(.*)</pid>" => "...", |
| "<ppid>(.*)</ppid>" => "...", |
| "<time>(.*)</time>" => "...", |
| "<obj>(.*)</obj>" => "...", |
| "<dir>(.*)</dir>" => "...", |
| "<exe>(.*)</exe>" => "...", |
| "<tid>(.*)</tid>" => "...", |
| "<unique>(.*)</unique>" => "...", |
| "thread #([0-9]+)" => "x", |
| "0x([0-9a-zA-Z]+)" => "........", |
| "Using Valgrind-([^\\s]*)" => "X.Y.X", |
| "Copyright \\(C\\) ([0-9]{4}-[0-9]{4}).*" => "XXXX-YYYY" |
| ); |
| |
| # List of XML sections to be ignored. |
| my %ignore_sections = ( |
| "<errorcounts>" => "</errorcounts>", |
| "<suppcounts>" => "</suppcounts>" |
| ); |
| |
| |
| # If FILE matches any of the FILES return 1 |
| sub file_matches ($$) { |
| my ($file, $files) = @_; |
| my ($string, $qstring); |
| |
| foreach $string (@$files) { |
| $qstring = quotemeta($string); |
| return 1 if ($file =~ /$qstring/); |
| } |
| |
| return 0; |
| } |
| |
| |
| my $frame_buf = ""; |
| my ($file, $lineno, $in_frame, $keep_frame, $num_discarded, $ignore_line); |
| |
| $in_frame = $keep_frame = $num_discarded = $ignore_line = 0; |
| |
| line: |
| while (<STDIN>) { |
| my $line = $_; |
| chomp($line); |
| |
| # Check whether we're ignoring this piece of XML.. |
| if ($ignore_line) { |
| foreach my $tag (keys %ignore_sections) { |
| if ($line =~ $ignore_sections{$tag}) { |
| print "$tag...$ignore_sections{$tag}\n"; |
| $ignore_line = 0; |
| next line; |
| } |
| } |
| } else { |
| foreach my $tag (keys %ignore_sections) { |
| if ($line =~ $tag) { |
| $ignore_line = 1; |
| } |
| } |
| } |
| |
| next if ($ignore_line); |
| |
| # OK. This line is not to be ignored. |
| |
| # Massage line by applying PATTERNS. |
| foreach my $key (keys %patterns) { |
| if ($line =~ $key) { |
| $line =~ s/$1/$patterns{$key}/g; |
| } |
| } |
| |
| # Handle frames |
| if ($in_frame) { |
| if ($line =~ /<\/frame>/) { |
| $frame_buf .= "$line\n"; |
| # The end of a frame |
| if ($keep_frame) { |
| # First: If there were any preceding frames that were discarded |
| # print <frame>...</frame> |
| if ($num_discarded) { |
| print " <frame>...</frame>\n"; |
| $num_discarded = 0; |
| } |
| # Secondly: Write out the frame itself |
| print "$frame_buf"; |
| } else { |
| # We don't want to write this frame |
| ++$num_discarded; |
| } |
| $in_frame = $keep_frame = 0; |
| $file = ""; |
| } elsif ($line =~ /<file>(.*)<\/file>/) { |
| $frame_buf .= "$line\n"; |
| $file = $1; |
| if (file_matches($file, \@tool_files) || |
| file_matches($file, \@ARGV)) { |
| $keep_frame = 1; |
| } |
| } elsif ($line =~ /<line>(.*)<\/line>/) { |
| # This code assumes that <file> always precedes <line> |
| $lineno = $1; |
| if (file_matches($file, \@tool_files)) { |
| $line =~ s/$1/.../; |
| } |
| $frame_buf .= "$line\n"; |
| } else { |
| $frame_buf .= "$line\n"; |
| } |
| } else { |
| # not within frame |
| if ($line =~ /<\/stack>/) { |
| print " <frame>...</frame>\n" if ($num_discarded); |
| $num_discarded = 0; |
| } |
| if ($line =~ /<frame>/) { |
| $in_frame = 1; |
| $frame_buf = "$line\n"; |
| } else { |
| print "$line\n"; |
| } |
| } |
| } |
| |
| exit 0; |