pytest is not correctly auto-installed
[WebKit-https.git] / Tools / Scripts / run-leaks
1 #!/usr/bin/env 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 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         "  --output-file path           Store result in a file. If not specified, standard output is used.\n" .
50         "  --memgraph-file path         Store memgraph in a file.\n" .
51         "  --help                       Show this help message.\n";
52
53     my @callStacksToExclude = ();
54     my @typesToExclude = ();
55     my $outputPath;
56     my $memgraphPath;
57     my $help = 0;
58
59     my $getOptionsResult = GetOptions(
60         'exclude-callstack:s' => \@callStacksToExclude,
61         'exclude-type:s' => \@typesToExclude,
62         'output-file:s' => \$outputPath,
63         'memgraph-file:s' => \$memgraphPath,
64         'help' => \$help
65     );
66     my $pidOrExecutableName = $ARGV[0];
67
68     if (!$getOptionsResult || $help) {
69         print STDERR $usage;
70         return 1;
71     }
72
73     if (!$pidOrExecutableName) {
74         reportError("Missing argument: pid | executable.");
75         print STDERR $usage;
76         return 1;
77     }
78
79     # Run leaks tool.
80     my $leaksOutput = runLeaks($pidOrExecutableName, $memgraphPath);
81     if (!$leaksOutput) {
82         return 1;
83     }
84
85     my $parsedOutput = parseLeaksOutput(@$leaksOutput);
86     if (!$parsedOutput) {
87         return 1;
88     }
89
90     # Filter output.
91     # FIXME: Adjust the overall leak count in the output accordingly. This will affect callers, notably leakdetector.py.
92     my $parsedLineCount = @$parsedOutput;
93     removeMatchingRecords(@$parsedOutput, "callStack", @callStacksToExclude);
94     removeMatchingRecords(@$parsedOutput, "type", @typesToExclude);
95     my $excludeCount = $parsedLineCount - @$parsedOutput;
96
97     my $outputFH;
98     if (defined $outputPath) {
99         open($outputFH , '>', $outputPath) or die "Could not open $outputPath for writing";
100     } else {
101         $outputFH = *STDOUT;
102     }
103
104     foreach my $leak (@$parsedOutput) {
105         print $outputFH $leak->{"leaksOutput"};
106     }
107
108     if ($excludeCount) {
109         print $outputFH "$excludeCount leaks excluded (not printed)\n";
110     }
111
112     return 0;
113 }
114
115 exit(main());
116
117 # Returns the output of the leaks tool in list form.
118 sub runLeaks($$)
119 {
120     my ($target, $memgraphPath) = @_;
121
122     if (defined $memgraphPath) {
123         `/usr/bin/leaks \"$target\" --outputGraph=\"$memgraphPath\"`;
124         $target = $memgraphPath;
125     }
126
127     # To get a result we can parse, we need to pass --list to all versions of the leaks tool
128     # that recognize it, but there is no certain way to tell in advance (the version of the
129     # tool is not always tied to OS version, and --help doesn't document the option in some
130     # of the tool versions where it's supported and needed).
131     my @leaksOutput = `/usr/bin/leaks \"$target\" --list`;
132
133     # FIXME: Remove the fallback once macOS Mojave is the oldest supported version.
134     my $leaksExitCode = $? >> 8;
135     if ($leaksExitCode > 1) {
136         @leaksOutput = `/usr/bin/leaks \"$target\"`;
137     }
138
139     return \@leaksOutput;
140 }
141
142 # Returns a list of hash references with the keys { address, size, type, callStack, leaksOutput }
143 sub parseLeaksOutput(\@)
144 {
145     my ($leaksOutput) = @_;
146
147     # Format:
148     #   Process 00000: 1234 nodes malloced for 1234 KB
149     #   Process 00000: XX leaks for XXX total leaked bytes.    
150     #   Leak: 0x00000000 size=1234 [instance of 'blah']
151     #       0x00000000 0x00000000 0x00000000 0x00000000 a..d.e.e
152     #       ...
153     #       Call stack: leak_caller() | leak() | malloc
154     #
155     #   We treat every line except for  Process 00000: and Leak: as optional
156
157     my $leakCount;
158     my @parsedOutput = ();
159     my $parsingLeak = 0;
160     my $parsedLeakCount = 0;
161     for my $line (@$leaksOutput) {
162         if ($line =~ /^Process \d+: (\d+) leaks?/) {
163             $leakCount = $1;
164         }
165
166         if ($line eq "\n") {
167             $parsingLeak = 0;
168         }
169
170         if ($line =~ /^Leak: /) {
171             $parsingLeak = 1;
172             $parsedLeakCount++;
173             my ($address) = ($line =~ /Leak: ([[:xdigit:]x]+)/);
174             if (!defined($address)) {
175                 reportError("Could not parse Leak address.");
176                 return;
177             }
178
179             my ($size) = ($line =~ /size=([[:digit:]]+)/);
180             if (!defined($size)) {
181                 reportError("Could not parse Leak size.");
182                 return;
183             }
184
185             # FIXME: This code seems wrong, the leaks tool doesn't actually use single quotes.
186             # We should reconcile with other format changes that happened since, such as the
187             # addition of zone information.
188             my ($type) = ($line =~ /'([^']+)'/); #'
189             if (!defined($type)) {
190                 $type = ""; # The leaks tool sometimes omits the type.
191             }
192
193             my %leak = (
194                 "address" => $address,
195                 "size" => $size,
196                 "type" => $type,
197                 "callStack" => "", # The leaks tool sometimes omits the call stack.
198                 "leaksOutput" => $line
199             );
200             push(@parsedOutput, \%leak);
201         } elsif ($parsingLeak) {
202             $parsedOutput[$#parsedOutput]->{"leaksOutput"} .= $line;
203             if ($line =~ /Call stack:/) {
204                 $parsedOutput[$#parsedOutput]->{"callStack"} = $line;
205             }
206         } else {
207             my %nonLeakLine = (
208                 "leaksOutput" => $line
209             );
210             push(@parsedOutput, \%nonLeakLine);
211         }
212     }
213     
214     if ($parsedLeakCount != $leakCount) {
215         reportError("Parsed leak count ($parsedLeakCount) does not match leak count reported by leaks tool ($leakCount).");
216         return;
217     }
218
219     return \@parsedOutput;
220 }
221
222 sub removeMatchingRecords(\@$\@)
223 {
224     my ($recordList, $key, $regexpList) = @_;
225     
226     RECORD: for (my $i = 0; $i < @$recordList;) {
227         my $record = $recordList->[$i];
228
229         foreach my $regexp (@$regexpList) {
230             if (defined $record->{$key} and $record->{$key} =~ $regexp) {
231                 splice(@$recordList, $i, 1);
232                 next RECORD;
233             }
234         }
235         
236         $i++;
237     }
238 }
239
240 sub reportError($)
241 {
242     my ($errorMessage) = @_;
243     
244     print STDERR basename($0) . ": $errorMessage\n";
245 }