File indexing completed on 2024-04-06 12:31:48
0001
0002
0003
0004
0005 use strict;
0006 use warnings;
0007 use Data::Dumper;
0008 use Date::Format;
0009 use Getopt::Long;
0010
0011 my $mstart = ;
0012 my $mstartuni = ;
0013 my $mstartfree = ;
0014 my $mtrace = ;
0015 my $version = undef;
0016 my @showstoppers = ;
0017
0018 my %presets = (
0019 'trash' => [ '__static_initialization_and_destruction_0', 'G__exec_statement', 'dlopen\@\@GLIBC_2', '_dl_lookup_symbol_x' ],
0020 'fwk' => [ ],
0021 'tom' => [ ,
0022 ],
0023 'prod' => [ '::(produce|filter)\(\s*edm::Event\s*&' , '::analyze\(\s*(?:const\s+)?edm::Event(?:\s+const)?\s*&' ],
0024 'prod1' => [ '::produce\(\s*\w+(?:\s+const)?\s*&\w*\s*\)' ],
0025 'prod1+' => [ '::produce\(\s*\w+(?:\s+const)?\s*&\w*\s*\)', 'edm::eventsetup::DataProxyTemplate<' ],
0026 );
0027 my $preset_names = join(', ', sort(keys(%presets)));
0028
0029 my @trace = (); my @libs = (); my @presets = (); my @dump_presets = ();
0030 my $help = ''; my $all = ''; my $onecolumn = ''; my $uninitialized = undef; my $free = undef;
0031
0032 GetOptions(
0033 'rel|release|r=s' => \$version,
0034 'libs|l=s' => \@libs,
0035 'trace|t=s' => \@trace,
0036 'stopper|showstopper=s'=> \@showstoppers,
0037 'onecolumn|1' => \$onecolumn,
0038 'all|a' => \$all,
0039 'preset=s' => \@presets,
0040 'dump-preset=s' => \@dump_presets,
0041 'uninitialized|u' => \$uninitialized,
0042 'free|f' => \$free,
0043 'help|h|?' => \$help);
0044 if ($uninitialized) { $mstart = $mstartuni; print STDERR "Hunting for uninitialized stuff\n"; }
0045 if ($free) { $mstart = $mstartfree; print STDERR "Hunting for free stuff\n"; }
0046 if ($help) {
0047 print <<_END;
0048 Usage: valgrindMemcheckParser.pl [ --rel RELEASE ]
0049 [ --libs lib1,lib2,-lib3 ]
0050 [ --trace match1,match2,-match3 ]
0051 [ --stopper lib1,lib2 ]
0052 [ --preset name,name,-name,+name,... ]
0053 [ --all ]
0054 [ --onecolumn ]
0055 [ --uninitialized | --free ]
0056 logfile [ logfile2 logfile3 ... ]
0057
0058 It will output a XHTML file to standard output.
0059
0060 If no input file is specified, reads from standard input.
0061
0062 FILTERS
0063 --libs: coma-separated list of libs to require in the library stack trace
0064 (or to exclude, if prefixed by a "-").
0065 Can be used multiple times.
0066 Abbreviation is "-l"
0067 --trace: coma-separated list of regexps to match in the stack trace
0068 (or to exclude, if prefixed by a "-").
0069 Can be used multiple times.
0070 Abbreviation is "-t"
0071 --stopper: coma-separated list of libs to cut the stack trace at;
0072 libFWCoreFramework.so is in by default.
0073 set it to "none" to never break stack trace.
0074 use full library name.
0075 --preset: use a specified preset filter for exclusion or inclusion.
0076 filter names are $preset_names
0077 --preset name : require at least one of the regexps in "name" to match
0078 in the stack trace
0079 --preset +name: requires all the regexp to match the in each stack trace
0080 (not all on the same stack trace element, of course)
0081 --preset -name: exclude the event if at least one regexp in name matches
0082 in the stack trace
0083 to get the contents of a preset use "--dump-preset name"
0084
0085 --all: show all leaks, skipping any filter
0086 Abbreviation is "-a"
0087
0088 --uninitialized (-u): look for uses of uninitialized memory instead of leaks
0089 --free (-f): look for bad calls to free() instead of memory leaks
0090
0091 Note: you can use PERL regexps in "libs", "trace"
0092
0093 HTML & LINKING OPTIONS
0094 --onecolunm: output things in one column, avoiding the column with the library name,
0095 for easier cut-n-paste in savannah
0096 an alias is "-1"
0097 --rel: CMSSW_*, or "nightly" (default: $version) to set LXR links
0098 aliases are "--release" and "-r"
0099 --link-files: if set to true (default is false), links to Uppercase identifiers are
0100 made using filename search instead of identifier search)
0101 [NOT IMPLEMENTED]
0102
0103 HELP
0104 --help : prints this stuff (also -h, -?)
0105 --dump-preset name: dumps the content of a preset and exit
0106
0107 _END
0108 exit;
0109 }
0110 if (@dump_presets) {
0111 foreach my $ps (@dump_presets) {
0112 print "Preset $ps: \n";
0113 print map("\t * '$_'\n", @{$presets{$ps}});
0114 print "\n";
0115 }
0116 exit;
0117 }
0118
0119
0120 @libs = split(/,/, join(',',@libs));
0121 @trace = split(/,/, join(',',@trace));
0122 @presets = split(/,/, join(',',@presets));
0123 @showstoppers= split(/,/, join(',',@showstoppers,'libFWCoreFramework'));
0124 if (grep($_ eq 'none', @showstoppers)) { @showstoppers = (); }
0125 my @trace_in = map (, grep ( $_ !~ , @trace ));
0126 my @trace_out = map (, grep ( s/^-//g, @trace ));
0127 my @libs_in = map (, grep ( $_ !~ , @libs ));
0128 my @libs_out = map (, grep ( s/^-//g, @libs ));
0129 my %stopmap = (); foreach (@showstoppers) { $stopmap{$_} = 1; }
0130 my %presets_c = ();
0131 foreach my $ps (keys(%presets)) { $presets_c{$ps} = [ map(, @{$presets{$ps}}) ] ; }
0132 my @leaks = ();
0133
0134 sub cfilter {
0135 my @trace = @{$_->{'trace'}};
0136 my $rx;
0137 foreach $rx (@trace_in ) { return 0 unless ( grep( $_->[0] =~ $rx, @trace) ); }
0138 foreach $rx (@trace_out) { return 0 if ( grep( $_->[0] =~ $rx, @trace) ); }
0139 foreach $rx (@libs_in ) { return 0 unless ( grep( $_->[1] =~ $rx, @trace) ); }
0140 foreach $rx (@libs_out) { return 0 if ( grep( $_->[1] =~ $rx, @trace) ); }
0141 foreach my $ps (@presets) {
0142 my ($op, $name) = ($ps =~ );
0143 if ($op eq '') {
0144 my $ok = 0;
0145 foreach $rx (@{$presets_c{$name}}) {
0146 if ( grep( $_->[0] =~ $rx, @trace) ) { $ok = 1; last; }
0147 }
0148 return 0 unless $ok;
0149 } elsif ($op eq '-') {
0150 foreach $rx (@{$presets_c{$name}}) {
0151 return 0 if ( grep( $_->[0] =~ $rx, @trace) );
0152 }
0153 } elsif ($op eq '+') {
0154 foreach $rx (@{$presets_c{$name}}) {
0155 return 0 unless ( grep( $_->[0] =~ $rx, @trace) );
0156 }
0157 }
0158 }
0159 return 1;
0160 }
0161
0162 sub realsize {
0163 my ($num) = ($_[0] =~ ) or return 0;
0164 $num =~ s/,//g;
0165 return eval($num);
0166 }
0167 sub fformat {
0168 my $vstring = (defined($version) ? "v=$version;" : "");
0169 my $func = &escapeHTML($_[0]);
0170 $func =~ s!(\b[A-Z]\w\w\w\w+)!<a class='obj' href='http://cmssdt.cern.ch/SDT/lxr/ident?${vstring}i=$1'>$1</a>!g;
0171 $func =~ s!::(\w+)\(!::<a class='func' href='http://cmssdt.cern.ch/SDT/lxr/ident?${vstring}i=$1'>$1</a>(!g;
0172 return $func;
0173 }
0174 sub escapeHTML {
0175 my $data=$_[0];
0176 $data =~ s!&!&!g;
0177 $data =~ s!<!<!g;
0178 $data =~ s!>!>!g;
0179 $data =~ s!"!"!g;
0180 return $data;
0181 }
0182
0183 while (<>) {
0184 if (/$mstart/) {
0185 my ($size, $status, $record) = ($1, $2, $3);
0186
0187
0188 my %libs = (); my @trace = ();
0189 while (<>) {
0190 my ($func, $lib) = /$mtrace/ or last;
0191
0192 $lib =~ s/^in \S+\/((?:lib|plugin)\w+)\.so/$1/;
0193 last if $stopmap{$lib};
0194 $libs{$lib} = 1; push @trace, [$func, $lib];
0195 die "I'm not defined" unless (defined($func) and defined($lib));
0196
0197 }
0198
0199 push @leaks, { 'size'=>$size, 'realsize' => realsize($size), 'status'=>$status, 'record'=>$record, 'libs'=>[keys(%libs)], 'trace'=>\@trace};
0200 }
0201 }
0202
0203
0204
0205 my @gleaks = ($all ? @leaks : grep ( cfilter($_), @leaks));
0206 my @sleaks = sort {$b->{'realsize'} <=> $a->{'realsize'}} @gleaks ;
0207 my $count = scalar(@sleaks);
0208 print STDERR "Selected $count leaks of " , scalar(@leaks) , ".\n";
0209 print <<EOF;
0210 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
0211 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
0212 <html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
0213 <head>
0214 <title>Valgrind MemCheck output</title>
0215 <link rel='stylesheet' type='text/css' href='valgrindMemcheckParser.css' />
0216 </head>
0217 <body>
0218 <h1>Valgrind MemCheck output ($count leaks)</h1>
0219
0220 <table width="100\%">
0221 EOF
0222 my $idx = 0;
0223 foreach my $l (@sleaks) {
0224 my %L = %{$l}; $idx++;
0225 my $colspan = ($onecolumn ? 1 : 2);
0226 my $aname = sprintf("L%04d", $idx);
0227 print "<tr class='header'><th class='header' colspan='$colspan'><a name=\"$aname\">Leak $idx</a>: $L{size} $L{status} ($L{record}) <a href=\"#$aname\">[href]</a></th></tr>\n";
0228 foreach my $sf (@{$L{'trace'}}) {
0229 print "<tr class='trace'><td class='func'>" . fformat($sf->[0]) . "</td>";
0230 print "<td class='lib'>" . $sf->[1]. "</td>" unless $onecolumn;
0231 print "</tr>\n";
0232 }
0233 }
0234
0235 my $footer = "Done at " . scalar(localtime());
0236 print <<EOF;
0237 </table>
0238 <p class='footer'>$footer</p>
0239 </body>
0240 </html>
0241 EOF