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 # Setup the directory to process
25 if (exists $opt{dir}) {
26 $opt{dir} = File::Spec->canonpath($opt{dir});
29 # Check if we're in 't'
30 $opt{dir} = cwd =~ /\/t$/ ? '..' : '.';
32 # Check if we're in the right directory
33 -d "$opt{dir}/$_" or die "$0: must be run from the perl source directory"
34 . " when --dir is not given\n"
38 # Assemble regex for functions whose leaks should be hidden
39 # (no, a hash won't be significantly faster)
40 my $hidden = do { local $"='|'; $opt{hide} ? qr/^(?:@{$opt{hide}})$/o : '' };
42 # Setup our output file handle
43 # (do it early, as it may fail)
45 if (exists $opt{'output-file'}) {
46 $fh = new IO::File ">$opt{'output-file'}"
47 or die "$0: cannot open $opt{'output-file'} ($!)\n";
50 # These hashes will receive the error and leak summary data:
55 # test_script => occurences
63 # test_script => occurences
65 # } # stack frames are separated by '<'s
69 # Collect summary data
70 find({wanted => \&filter, no_chdir => 1}, $opt{dir});
80 $Text::Wrap::columns = 80;
82 print $fh "MEMORY ACCESS ERRORS\n\n";
84 for my $e (sort keys %error) {
86 for my $frame (sort keys %{$error{$e}}) {
87 print $fh ' 'x4, "$frame\n",
88 wrap(' 'x8, ' 'x8, join ', ', sort keys %{$error{$e}{$frame}}),
94 print $fh "\nMEMORY LEAKS\n\n";
96 for my $l (sort keys %leak) {
98 for my $frames (sort keys %{$leak{$l}}) {
99 my @stack = split /</, $frames;
100 print $fh join('', map { ' 'x4 . "$_:$stack[$_]\n" } 0 .. $#stack ),
101 wrap(' 'x8, ' 'x8, join ', ', sort keys %{$leak{$l}{$frames}}),
108 debug(2, "$File::Find::name\n");
110 # Only process '*.t.valgrind' files
111 /(.*)\.t\.valgrind$/ or return;
113 # Strip all unnecessary stuff from the test name
115 $test =~ s/^(?:(?:\Q$opt{dir}\E|[.t])\/)+//;
117 debug(1, "processing $test ($_)\n");
119 # Get all the valgrind output lines
120 my @l = map { chomp; s/^==\d+==\s?//; $_ }
121 do { my $fh = new IO::File $_ or die "$0: cannot open $_ ($!)\n"; <$fh> };
123 # Setup some useful regexes
124 my $hexaddr = '0x[[:xdigit:]]+';
125 my $topframe = qr/^\s+at $hexaddr:\s+/;
126 my $address = qr/^\s+Address $hexaddr is \d+ bytes (?:before|inside|after) a block of size \d+/;
127 my $leak = qr/^\s*\d+ bytes in \d+ blocks are (still reachable|(?:definite|possib)ly lost)/;
129 for my $i (0 .. $#l) {
130 $l[$i] =~ $topframe or next; # Match on any topmost frame...
131 $l[$i-1] =~ $address and next; # ...but not if it's only address details
132 my $line = $l[$i-1]; # The error / leak description line
135 if ($line =~ $leak) {
136 debug(2, "LEAK: $line\n");
138 my $type = $1; # Type of leak (still reachable, ...)
139 my $inperl = 0; # Are we inside the perl source? (And how deep?)
140 my @stack; # Call stack
142 while ($l[$j++] =~ /^\s+(?:at|by) $hexaddr:\s+((\w+)\s+\((?:([^:]+:\d+)|[^)]+)\))/o) {
143 my($frame, $func, $loc) = ($1, $2, $3);
145 # If the stack frame is inside perl => increment $inperl
146 # If we've already been inside perl, but are no longer => leave
147 defined $loc && ++$inperl or $inperl && last;
149 # A function that should be hidden? => clear stack and leave
150 $hidden && $func =~ $hidden and @stack = (), last;
152 # Add stack frame if it's within our threshold
153 $inperl <= $opt{frames} and push @stack, $inperl ? $frame : $func;
156 # If there's something on the stack and we've seen perl code,
157 # add this memory leak to the summary data
158 @stack and $inperl and $leak{$type}{join '<', @stack}{$test}++;
160 debug(1, "ERROR: $line\n");
162 # Simply find the topmost frame in the call stack within
163 # the perl source code
164 while ($l[$j++] =~ /^\s+(?:at|by) $hexaddr:\s+(\w+\s+\([^:]+:\d+\))?/o) {
166 $error{$line}{$1}{$test}++;
176 $opt{verbose} >= $level and print STDERR @_;
183 valgrindpp.pl - A post processor for make test.valgrind
187 valgrindpp.pl [B<--dir>=I<dir>] [B<--output-file>=I<file>]
188 [B<--frames>=I<number>] [B<--hide>=I<identifier>] [B<--verbose>]
192 B<valgrindpp.pl> is a post processor for I<.valgrind> files
193 created during I<make test.valgrind>. It collects all these
194 files, extracts most of the information and produces a
195 significantly shorter summary of all detected memory access
196 errors and memory leaks.
202 =item B<--dir>=I<dir>
204 Recursively process I<.valgrind> files in I<dir>. If this
205 options is not given, B<valgrindpp.pl> must be run from
206 either the perl source or the I<t> directory and will process
207 all I<.valgrind> files within the distribution.
209 =item B<--output-file>=I<file>
211 Redirect the output into I<file>. If this option is not
212 given, the output goes to I<stdout>.
214 =item B<--frames>=I<number>
216 Number of stack frames within the perl source code to
217 consider when distinguishing between memory leak sources.
218 Increasing this value will give you a longer backtrace,
219 while decreasing the number will show you fewer sources
220 for memory leaks. The default is 3 frames.
222 =item B<--hide>=I<identifier>
224 Hide all memory leaks that have I<identifier> in their backtrace.
225 Useful if you want to hide leaks from functions that are known to
226 have lots of memory leaks. I<identifier> can also be a regular
227 expression, in which case all leaks with symbols matching the
228 expression are hidden. Can be given multiple times.
232 Increase verbosity level. Can be given multiple times.
238 Copyright 2003 by Marcus Holland-Moritz <mhx@cpan.org>.
240 This program is free software; you may redistribute it
241 and/or modify it under the same terms as Perl itself.