From: Jarkko Hietaniemi Date: Wed, 27 Aug 2003 16:49:22 +0000 (+0000) Subject: Add the valgrindpp.pl script from Marcus Holland-Moritz. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=77c22dc1754c82dd7ac259e768986525130fce5d;p=p5sagit%2Fp5-mst-13.2.git Add the valgrindpp.pl script from Marcus Holland-Moritz. p4raw-id: //depot/perl@20920 --- diff --git a/MANIFEST b/MANIFEST index 60a2f97..53e08f9 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2427,8 +2427,9 @@ Porting/patchls Flexible patch file listing utility Porting/pumpkin.pod Guidelines and hints for Perl maintainers Porting/repository.pod How to use the Perl repository Porting/sort_perldiag.pl Keep our diagnostics orderly -Porting/testall.atom Cumulative profile of the test suite with Third Degree -Porting/thirdclean Cleanup Third Degree reports +Porting/testall.atom Cumulative profile with Third Degree +Porting/thirdclean Cleanup Third Degree reports +Porting/valgrindpp.pl Summarize valgrind reports pp.c Push/Pop code pp_ctl.c Push/Pop code for control flow pp.h Push/Pop code defs diff --git a/Porting/valgrindpp.pl b/Porting/valgrindpp.pl new file mode 100644 index 0000000..4ae539c --- /dev/null +++ b/Porting/valgrindpp.pl @@ -0,0 +1,185 @@ +#!/usr/bin/perl +use IO::File (); +use File::Find qw(find); +use Text::Wrap qw(wrap); +use Getopt::Long qw(GetOptions); +use Pod::Usage qw(pod2usage); +use strict; + +my %opt = ( + hide => [], + frames => 3, + debug => 0, +); + +GetOptions( \%opt, + qw( + hide=s@ + output-file=s + frames=i + debug+ + ) ) or pod2usage(2); + +my %hide; +my $hide_re = join '|', map { /^\w+$/ && ++$hide{$_} ? () : $_ } @{$opt{hide}}; +$hide_re and $hide_re = qr/^(?:$hide_re)$/o; + +my $fh = \*STDOUT; +if (exists $opt{'output-file'}) { + $fh = new IO::File ">$opt{'output-file'}" + or die "$opt{'output-file'}: $!\n"; +} + +my(%error, %leak); + +find({wanted => \&filter, no_chdir => 1}, '.'); +summary($fh); + +exit 0; + +sub summary { + my $fh = shift; + + $Text::Wrap::columns = 80; + + print $fh "MEMORY ACCESS ERRORS\n\n"; + + for my $e (sort keys %error) { + print $fh qq("$e"\n); + for my $frame (sort keys %{$error{$e}}) { + print $fh ' 'x4, "$frame\n", + wrap(' 'x8, ' 'x8, join ', ', sort keys %{$error{$e}{$frame}}), + "\n"; + } + print $fh "\n"; + } + + print $fh "\nMEMORY LEAKS\n\n"; + + for my $l (sort keys %leak) { + print $fh qq("$l"\n); + for my $frames (sort keys %{$leak{$l}}) { + my @stack = split / }; + + my $hexaddr = '0x[[:xdigit:]]+'; + my $topframe = qr/^\s+at $hexaddr:\s+/o; + my $address = qr/^\s+Address $hexaddr is \d+ bytes (?:before|inside|after) a block of size \d+/o; + my $leak = qr/^\s*\d+ bytes in \d+ blocks are (still reachable|(?:definite|possib)ly lost)/o; + + for my $i (0 .. $#l) { + $l[$i] =~ $topframe or next; # match on any topmost frame... + $l[$i-1] =~ $address and next; # ...but not if it's only address details + my $line = $l[$i-1]; + my $j = $i; + + if ($line =~ $leak) { + debug(2, "LEAK: $line\n"); + + my $kind = $1; + my $inperl = 0; + my @stack; + + while ($l[$j++] =~ /^\s+(?:at|by) $hexaddr:\s+((\w+)\s+\((?:([^:]+:\d+)|[^)]+)\))/o) { + my($frame, $func, $loc) = ($1, $2, $3); + defined $loc && ++$inperl or $inperl && last; + if (exists $hide{$func} or $hide_re && $func =~ $hide_re) { + @stack = (); + last; + } + $inperl <= $opt{frames} and push @stack, $inperl ? $frame : $func; + } + + @stack and $inperl and $leak{$kind}{join '<', @stack}{$test}++; + } else { + debug(1, "ERROR: $line\n"); + + while ($l[$j++] =~ /^\s+(?:at|by) $hexaddr:\s+(\w+\s+\([^:]+:\d+\))?/o) { + if (defined $1) { + $error{$line}{$1}{$test}++; + last; + } + } + } + } +} + +sub debug { + my $level = shift; + $opt{debug} >= $level and print STDERR @_; +} + +__END__ + +=head1 NAME + +valgrindpp.pl - A post processor for make test.valgrind + +=head1 SYNOPSIS + +valgrindpp.pl [B<--output-file>=I] [B<--frames>=I] +[B<--hide>=I] [B<--debug>] + +=head1 DESCRIPTION + +B is a post processor for I<.valgrind> files +created during I. It collects all these +files, extracts most of the information and produces a +significantly shorter summary of all detected memory access +errors and memory leaks. + +=head1 OPTIONS + +=over 4 + +=item B<--output-file>=I + +Redirect the output into I. If this option is not +given, the output goes to I. + +=item B<--frames>=I + +Number of stack frames within the perl source code to +consider when distinguishing between memory leak sources. +Increasing this value will give you a longer backtrace, +while decreasing the number will show you fewer sources +for memory leaks. The default is 3 frames. + +=item B<--hide>=I + +Hide all memory leaks that have I in their backtrace. +Useful if you want to hide leaks from functions that are known to +have lots of memory leaks. I can also be a regular +expression, in which case all leaks with symbols matching the +expression are hidden. Can be given multiple times. + +=item B<--debug> + +Increase debug level. Can be given multiple times. + +=back + +=head1 COPYRIGHT + +Copyright 2003 by Marcus Holland-Moritz . + +This program is free software; you may redistribute it +and/or modify it under the same terms as Perl itself. + +=cut