Tools/Scripts/run-leaks

   1 #!/usr/bin/perl
   2
   3 # Copyright (C) 2007 Apple Inc. All rights reserved.
   4 #
   5 # Redistribution and use in source and binary forms, with or without
   6 # modification, are permitted provided that the following conditions
   7 # are met:
   8 #
   9 # 1.  Redistributions of source code must retain the above copyright
  10 #     notice, this list of conditions and the following disclaimer.
  11 # 2.  Redistributions in binary form must reproduce the above copyright
  12 #     notice, this list of conditions and the following disclaimer in the
  13 #     documentation and/or other materials provided with the distribution.
  14 # 3.  Neither the name of Apple Computer, Inc. ("Apple") nor the names of
  15 #     its contributors may be used to endorse or promote products derived
  16 #     from this software without specific prior written permission.
  17 #
  18 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY
  19 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  20 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  21 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY
  22 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  23 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  24 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  25 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  27 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28
  29 # Script to run the Mac OS X leaks tool with more expressive '-exclude' lists.
  30
  31 use strict;
  32 use warnings;
  33
  34 use File::Basename;
  35 use Getopt::Long;
  36
  37 sub runLeaks($);
  38 sub parseLeaksOutput(\@);
  39 sub removeMatchingRecords(\@$\@);
  40 sub reportError($);
  41
  42 sub main()
  43 {
  44     # Read options.
  45     my $usage =
  46         "Usage: " . basename($0) . " [options] pid | executable name\n" .
  47         "  --exclude-callstack regexp   Exclude leaks whose call stacks match the regular expression 'regexp'.\n" .
  48         "  --exclude-type regexp        Exclude leaks whose data types match the regular expression 'regexp'.\n" .
  49         "  --help                       Show this help message.\n";
  50
  51     my @callStacksToExclude = ();
  52     my @typesToExclude = ();
  53     my $help = 0;
  54
  55     my $getOptionsResult = GetOptions(
  56         'exclude-callstack:s' => \@callStacksToExclude,
  57         'exclude-type:s' => \@typesToExclude,
  58         'help' => \$help
  59     );
  60     my $pidOrExecutableName = $ARGV[0];
  61
  62     if (!$getOptionsResult || $help) {
  63         print STDERR $usage;
  64         return 1;
  65     }
  66
  67     if (!$pidOrExecutableName) {
  68         reportError("Missing argument: pid | executable.");
  69         print STDERR $usage;
  70         return 1;
  71     }
  72
  73     # Run leaks tool.
  74     my $leaksOutput = runLeaks($pidOrExecutableName);
  75     if (!$leaksOutput) {
  76         return 1;
  77     }
  78
  79     my $leakList = parseLeaksOutput(@$leaksOutput);
  80     if (!$leakList) {
  81         return 1;
  82     }
  83
  84     # Filter output.
  85     my $leakCount = @$leakList;
  86     removeMatchingRecords(@$leakList, "callStack", @callStacksToExclude);
  87     removeMatchingRecords(@$leakList, "type", @typesToExclude);
  88     my $excludeCount = $leakCount - @$leakList;
  89
  90     # Dump results.
  91     print $leaksOutput->[0];
  92     print $leaksOutput->[1];
  93     foreach my $leak (@$leakList) {
  94         print $leak->{"leaksOutput"};
  95     }
  96
  97     if ($excludeCount) {
  98         print "$excludeCount leaks excluded (not printed)\n";
  99     }
 100
 101     return 0;
 102 }
 103
 104 exit(main());
 105
 106 # Returns the output of the leaks tool in list form.
 107 sub runLeaks($)
 108 {
 109     my ($pidOrExecutableName) = @_;
 110
 111     my @leaksOutput = `leaks $pidOrExecutableName`;
 112     if (!@leaksOutput) {
 113         reportError("Error running leaks tool.");
 114         return;
 115     }
 116
 117     return \@leaksOutput;
 118 }
 119
 120 # Returns a list of hash references with the keys { address, size, type, callStack, leaksOutput }
 121 sub parseLeaksOutput(\@)
 122 {
 123     my ($leaksOutput) = @_;
 124
 125     # Format:
 126     #   Process 00000: 1234 nodes malloced for 1234 KB
 127     #   Process 00000: XX leaks for XXX total leaked bytes.
 128     #   Leak: 0x00000000 size=1234 [instance of 'blah']
 129     #       0x00000000 0x00000000 0x00000000 0x00000000 a..d.e.e
 130     #       ...
 131     #       Call stack: leak_caller() | leak() | malloc
 132     #
 133     #   We treat every line except for  Process 00000: and Leak: as optional
 134
 135     # Skip header section until the first two "Process " lines.
 136     # FIXME: In the future we may wish to propagate the header section through to our output.
 137     until ($leaksOutput->[0] =~ /^Process /) {
 138         shift @$leaksOutput;
 139     }
 140
 141     my ($leakCount) = ($leaksOutput->[1] =~ /[[:blank:]]+([0-9]+)[[:blank:]]+leaks?/);
 142     if (!defined($leakCount)) {
 143         reportError("Could not parse leak count reported by leaks tool.");
 144         return;
 145     }
 146
 147     my @leakList = ();
 148     for my $line (@$leaksOutput) {
 149         next if $line =~ /^Process/;
 150         next if $line =~ /^node buffer added/;
 151
 152         if ($line =~ /^Leak: /) {
 153             my ($address) = ($line =~ /Leak: ([[:xdigit:]x]+)/);
 154             if (!defined($address)) {
 155                 reportError("Could not parse Leak address.");
 156                 return;
 157             }
 158
 159             my ($size) = ($line =~ /size=([[:digit:]]+)/);
 160             if (!defined($size)) {
 161                 reportError("Could not parse Leak size.");
 162                 return;
 163             }
 164
 165             my ($type) = ($line =~ /'([^']+)'/); #'
 166             if (!defined($type)) {
 167                 $type = ""; # The leaks tool sometimes omits the type.
 168             }
 169
 170             my %leak = (
 171                 "address" => $address,
 172                 "size" => $size,
 173                 "type" => $type,
 174                 "callStack" => "", # The leaks tool sometimes omits the call stack.
 175                 "leaksOutput" => $line
 176             );
 177             push(@leakList, \%leak);
 178         } else {
 179             $leakList[$#leakList]->{"leaksOutput"} .= $line;
 180             if ($line =~ /Call stack:/) {
 181                 $leakList[$#leakList]->{"callStack"} = $line;
 182             }
 183         }
 184     }
 185
 186     if (@leakList != $leakCount) {
 187         my $parsedLeakCount = @leakList;
 188         reportError("Parsed leak count($parsedLeakCount) does not match leak count reported by leaks tool($leakCount).");
 189         return;
 190     }
 191
 192     return \@leakList;
 193 }
 194
 195 sub removeMatchingRecords(\@$\@)
 196 {
 197     my ($recordList, $key, $regexpList) = @_;
 198
 199     RECORD: for (my $i = 0; $i < @$recordList;) {
 200         my $record = $recordList->[$i];
 201
 202         foreach my $regexp (@$regexpList) {
 203             if ($record->{$key} =~ $regexp) {
 204                 splice(@$recordList, $i, 1);
 205                 next RECORD;
 206             }
 207         }
 208
 209         $i++;
 210     }
 211 }
 212
 213 sub reportError($)
 214 {
 215     my ($errorMessage) = @_;
 216
 217     print STDERR basename($0) . ": $errorMessage\n";
 218 }