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; 174
