Clean up ChunkedUpdateDrawingAreaProxy
[WebKit-https.git] / WebKitTools / 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     # Newer versions of the leaks output have a header section at the top, with the first line describing the version of the output format.
136     # If we detect the new format is being used then we eat all of the header section so the output matches the format of older versions.
137     # FIXME: In the future we may wish to propagate this section through to our output.
138     if ($leaksOutput->[0] =~ /^leaks Report Version:/) {
139         while ($leaksOutput->[0] !~ /^Process /) {
140             shift @$leaksOutput;
141         }
142     }
143
144     my ($leakCount) = ($leaksOutput->[1] =~ /[[:blank:]]+([0-9]+)[[:blank:]]+leaks?/);
145     if (!defined($leakCount)) {
146         reportError("Could not parse leak count reported by leaks tool.");
147         return;
148     }
149
150     my @leakList = ();
151     for my $line (@$leaksOutput) {
152         next if $line =~ /^Process/;
153         next if $line =~ /^node buffer added/;
154         
155         if ($line =~ /^Leak: /) {
156             my ($address) = ($line =~ /Leak: ([[:xdigit:]x]+)/);
157             if (!defined($address)) {
158                 reportError("Could not parse Leak address.");
159                 return;
160             }
161
162             my ($size) = ($line =~ /size=([[:digit:]]+)/);
163             if (!defined($size)) {
164                 reportError("Could not parse Leak size.");
165                 return;
166             }
167
168             my ($type) = ($line =~ /'([^']+)'/); #'
169             if (!defined($type)) {
170                 $type = ""; # The leaks tool sometimes omits the type.
171             }
172
173             my %leak = (
174                 "address" => $address,
175                 "size" => $size,
176                 "type" => $type,
177                 "callStack" => "", # The leaks tool sometimes omits the call stack.
178                 "leaksOutput" => $line
179             );
180             push(@leakList, \%leak);
181         } else {
182             $leakList[$#leakList]->{"leaksOutput"} .= $line;
183             if ($line =~ /Call stack:/) {
184                 $leakList[$#leakList]->{"callStack"} = $line;
185             }
186         }
187     }
188     
189     if (@leakList != $leakCount) {
190         my $parsedLeakCount = @leakList;
191         reportError("Parsed leak count($parsedLeakCount) does not match leak count reported by leaks tool($leakCount).");
192         return;
193     }
194
195     return \@leakList;
196 }
197
198 sub removeMatchingRecords(\@$\@)
199 {
200     my ($recordList, $key, $regexpList) = @_;
201     
202     RECORD: for (my $i = 0; $i < @$recordList;) {
203         my $record = $recordList->[$i];
204
205         foreach my $regexp (@$regexpList) {
206             if ($record->{$key} =~ $regexp) {
207                 splice(@$recordList, $i, 1);
208                 next RECORD;
209             }
210         }
211         
212         $i++;
213     }
214 }
215
216 sub reportError($)
217 {
218     my ($errorMessage) = @_;
219     
220     print STDERR basename($0) . ": $errorMessage\n";
221 }