3 use File::Find qw(find);
4 use Text::Wrap qw(wrap);
5 use Getopt::Long qw(GetOptions);
6 use Pod::Usage qw(pod2usage);
24 my $hide_re = join '|', map { /^\w+$/ && ++$hide{$_} ? () : $_ } @{$opt{hide}};
25 $hide_re and $hide_re = qr/^(?:$hide_re)$/o;
28 if (exists $opt{'output-file'}) {
29 $fh = new IO::File ">$opt{'output-file'}"
30 or die "$opt{'output-file'}: $!\n";
35 find({wanted => \&filter, no_chdir => 1}, '.');
43 $Text::Wrap::columns = 80;
45 print $fh "MEMORY ACCESS ERRORS\n\n";
47 for my $e (sort keys %error) {
49 for my $frame (sort keys %{$error{$e}}) {
50 print $fh ' 'x4, "$frame\n",
51 wrap(' 'x8, ' 'x8, join ', ', sort keys %{$error{$e}{$frame}}),
57 print $fh "\nMEMORY LEAKS\n\n";
59 for my $l (sort keys %leak) {
61 for my $frames (sort keys %{$leak{$l}}) {
62 my @stack = split /</, $frames;
63 print $fh join('', map { ' 'x4 . "$_:$stack[$_]\n" } 0 .. $#stack ),
64 wrap(' 'x8, ' 'x8, join ', ', sort keys %{$leak{$l}{$frames}}),
71 debug(1, "$File::Find::name\n");
73 /(.*)\.valgrind$/ or return;
76 $test =~ s/^[.t]\///g;
78 my @l = map { chomp; s/^==\d+==\s?//; $_ }
79 do { my $fh = new IO::File $_ or die "$_: $!\n"; <$fh> };
81 my $hexaddr = '0x[[:xdigit:]]+';
82 my $topframe = qr/^\s+at $hexaddr:\s+/o;
83 my $address = qr/^\s+Address $hexaddr is \d+ bytes (?:before|inside|after) a block of size \d+/o;
84 my $leak = qr/^\s*\d+ bytes in \d+ blocks are (still reachable|(?:definite|possib)ly lost)/o;
86 for my $i (0 .. $#l) {
87 $l[$i] =~ $topframe or next; # match on any topmost frame...
88 $l[$i-1] =~ $address and next; # ...but not if it's only address details
93 debug(2, "LEAK: $line\n");
99 while ($l[$j++] =~ /^\s+(?:at|by) $hexaddr:\s+((\w+)\s+\((?:([^:]+:\d+)|[^)]+)\))/o) {
100 my($frame, $func, $loc) = ($1, $2, $3);
101 defined $loc && ++$inperl or $inperl && last;
102 if (exists $hide{$func} or $hide_re && $func =~ $hide_re) {
106 $inperl <= $opt{frames} and push @stack, $inperl ? $frame : $func;
109 @stack and $inperl and $leak{$kind}{join '<', @stack}{$test}++;
111 debug(1, "ERROR: $line\n");
113 while ($l[$j++] =~ /^\s+(?:at|by) $hexaddr:\s+(\w+\s+\([^:]+:\d+\))?/o) {
115 $error{$line}{$1}{$test}++;
125 $opt{debug} >= $level and print STDERR @_;
132 valgrindpp.pl - A post processor for make test.valgrind
136 valgrindpp.pl [B<--output-file>=I<file>] [B<--frames>=I<number>]
137 [B<--hide>=I<identifier>] [B<--debug>]
141 B<valgrindpp.pl> is a post processor for I<.valgrind> files
142 created during I<make test.valgrind>. It collects all these
143 files, extracts most of the information and produces a
144 significantly shorter summary of all detected memory access
145 errors and memory leaks.
151 =item B<--output-file>=I<file>
153 Redirect the output into I<file>. If this option is not
154 given, the output goes to I<stdout>.
156 =item B<--frames>=I<number>
158 Number of stack frames within the perl source code to
159 consider when distinguishing between memory leak sources.
160 Increasing this value will give you a longer backtrace,
161 while decreasing the number will show you fewer sources
162 for memory leaks. The default is 3 frames.
164 =item B<--hide>=I<identifier>
166 Hide all memory leaks that have I<identifier> in their backtrace.
167 Useful if you want to hide leaks from functions that are known to
168 have lots of memory leaks. I<identifier> can also be a regular
169 expression, in which case all leaks with symbols matching the
170 expression are hidden. Can be given multiple times.
174 Increase debug level. Can be given multiple times.
180 Copyright 2003 by Marcus Holland-Moritz <mhx@cpan.org>.
182 This program is free software; you may redistribute it
183 and/or modify it under the same terms as Perl itself.