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
19use warnings;
20use 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#---------------------------------------------------------------------
26my @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.
30my %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.
46my %ignore_sections = (
47    "<errorcounts>" => "</errorcounts>",
48    "<suppcounts>"  => "</suppcounts>"
49);
50
51
52# If FILE matches any of the FILES return 1
53sub 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
66my $frame_buf = "";
67my ($file, $lineno, $in_frame, $keep_frame, $num_discarded, $ignore_line);
68
69$in_frame = $keep_frame = $num_discarded = $ignore_line = 0;
70
71line: 
72while (<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
156exit 0;
157