webengine/osswebengine/WebKitTools/Scripts/run-leaks
changeset 0 dd21522fd290
equal deleted inserted replaced
-1:000000000000 0:dd21522fd290
       
     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     my ($leakCount) = ($leaksOutput->[1] =~ /[[:blank:]]+([0-9]+)[[:blank:]]+leaks?/);
       
   136     if (!defined($leakCount)) {
       
   137         reportError("Could not parse leak count reported by leaks tool.");
       
   138         return;
       
   139     }
       
   140 
       
   141     my @leakList = ();
       
   142     for my $line (@$leaksOutput) {
       
   143         next if $line =~ /^Process/;
       
   144         next if $line =~ /^node buffer added/;
       
   145         
       
   146         if ($line =~ /^Leak: /) {
       
   147             my ($address) = ($line =~ /Leak: ([[:xdigit:]x]+)/);
       
   148             if (!defined($address)) {
       
   149                 reportError("Could not parse Leak address.");
       
   150                 return;
       
   151             }
       
   152 
       
   153             my ($size) = ($line =~ /size=([[:digit:]]+)/);
       
   154             if (!defined($size)) {
       
   155                 reportError("Could not parse Leak size.");
       
   156                 return;
       
   157             }
       
   158 
       
   159             my ($type) = ($line =~ /'([^']+)'/); #'
       
   160             if (!defined($type)) {
       
   161                 $type = ""; # The leaks tool sometimes omits the type.
       
   162             }
       
   163 
       
   164             my %leak = (
       
   165                 "address" => $address,
       
   166                 "size" => $size,
       
   167                 "type" => $type,
       
   168                 "callStack" => "", # The leaks tool sometimes omits the call stack.
       
   169                 "leaksOutput" => $line
       
   170             );
       
   171             push(@leakList, \%leak);
       
   172         } else {
       
   173             $leakList[$#leakList]->{"leaksOutput"} .= $line;
       
   174             if ($line =~ /Call stack:/) {
       
   175                 $leakList[$#leakList]->{"callStack"} = $line;
       
   176             }
       
   177         }
       
   178     }
       
   179     
       
   180     if (@leakList != $leakCount) {
       
   181         my $parsedLeakCount = @leakList;
       
   182         reportError("Parsed leak count($parsedLeakCount) does not match leak count reported by leaks tool($leakCount).");
       
   183         return;
       
   184     }
       
   185 
       
   186     return \@leakList;
       
   187 }
       
   188 
       
   189 sub removeMatchingRecords(\@$\@)
       
   190 {
       
   191     my ($recordList, $key, $regexpList) = @_;
       
   192     
       
   193     RECORD: for (my $i = 0; $i < @$recordList;) {
       
   194         my $record = $recordList->[$i];
       
   195 
       
   196         foreach my $regexp (@$regexpList) {
       
   197             if ($record->{$key} =~ $regexp) {
       
   198                 splice(@$recordList, $i, 1);
       
   199                 next RECORD;
       
   200             }
       
   201         }
       
   202         
       
   203         $i++;
       
   204     }
       
   205 }
       
   206 
       
   207 sub reportError($)
       
   208 {
       
   209     my ($errorMessage) = @_;
       
   210     
       
   211     print STDERR basename($0) . ": $errorMessage\n";
       
   212 }