Unreviewed. Add Silvia Pfeiffer to contributor list.
[WebKit-https.git] / 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 }