Working on coverage script, added xml to json data extraction script.
[WebKit-https.git] / Tools / Scripts / generate-coverage-data
1 #!/usr/bin/perl -w
2
3 # Copyright (C) 2005, 2006, 2013 Apple Computer, Inc.  All rights reserved.
4 # Copyright (C) 2007 Holger Hans Peter Freyther.  All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 #
10 # 1.  Redistributions of source code must retain the above copyright
11 #     notice, this list of conditions and the following disclaimer. 
12 # 2.  Redistributions in binary form must reproduce the above copyright
13 #     notice, this list of conditions and the following disclaimer in the
14 #     documentation and/or other materials provided with the distribution. 
15 # 3.  Neither the name of Apple Computer, Inc. ("Apple") nor the names of
16 #     its contributors may be used to endorse or promote products derived
17 #     from this software without specific prior written permission. 
18 #
19 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY
20 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
21 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
22 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY
23 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
24 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
25 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
26 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
27 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
28 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
30 # Script to build, run and visualize coverage information
31
32 use strict;
33 use File::Basename;
34 use File::Spec;
35 use FindBin;
36 use Getopt::Long qw(:config pass_through);
37 use JSON;
38 use lib $FindBin::Bin;
39 use List::Util qw(sum);
40 use List::Util qw(max);
41 use POSIX;
42 use webkitdirs;
43 use XML::Simple;
44
45 sub parseGcovrOutput($);
46 sub getFileHitsAndBranches($);
47 sub addLineCounts($$$$$$);
48 sub createResultName();
49
50 my $resultName = createResultName();
51
52 # Move to the source directory
53 chdirWebKit();
54
55 # Delete old gcov files
56 print "Cleaning up\n";
57 system("if [ -d WebKitBuild ]; then find WebKitBuild -name '*.gcda' -delete; fi;") == 0 or die "Cannot delete old gcda files (code coverage";
58
59 # Compile WebKit and run the tests
60 print "Building and testing\n";
61 system("Tools/Scripts/build-webkit", "--coverage", @ARGV) == 0 or die "Cannot compile webkit with code coverage";
62 system("Tools/Scripts/run-webkit-tests");
63 system("Tools/Scripts/run-webkit-tests -2");
64 system("Tools/Scripts/run-javascriptcore-tests");
65 system("Tools/Scripts/run-api-tests");
66
67 # Generate the coverage data and report
68 print "Collecting coverage data\n";
69 system("mkdir WebKitBuild/Coverage") if ! -d "WebKitBuild/Coverage";
70 system("python Tools/Scripts/webkitpy/tool/gcovr --xml --output=WebKitBuild/Coverage/" . $resultName . ".xml") == 0 or die "Cannot run gcovr";
71
72 # Collect useful data from xml to json format
73 open my $jsonFile, ">", "WebKitBuild/Coverage/$resultName.json" or die "Cannot open $resultName.json";
74 print $jsonFile encode_json(parseGcovrOutput("WebKitBuild/Coverage/$resultName.xml"));
75 close $jsonFile;
76
77 print "Done\n";
78
79 sub parseGcovrOutput($)
80 {
81     my ($xmlData) = @_;
82     my $sourceDir = sourceDir();
83     
84     my @files;
85
86     # The xml output of gcovr uses a Java-like package/class names for directories and files
87     my $packages = new XML::Simple->XMLin($xmlData)->{"packages"}->{"package"};
88
89     foreach my $packageName (keys %{$packages}) {
90         my $classes = $packages->{$packageName}->{"classes"}->{"class"};
91         
92         # Perl's XML::Simple causes files to be here in the parsed xml data structure
93         # if there's only one child, even though they're a layer deeper in the xml tree
94         if ($classes->{"filename"} && $classes->{"lines"}) {
95             if ($classes->{"filename"} =~ /$sourceDir/) {
96                 push(@files, getFileHitsAndBranches($classes));
97             }
98         }
99         else {
100             foreach my $key (keys %{$classes}) {
101                 my $class = $classes->{$key};
102                 if ($class->{"filename"} =~ /$sourceDir/) {
103                     push(@files,getFileHitsAndBranches($class));
104                 }
105             }
106         }
107     }
108     return \@files;
109 }
110
111 sub getFileHitsAndBranches($)
112 {
113     my ($class) = @_;
114
115     my @hits;
116     my @hitLines;
117     my @branchesPossible;
118     my @branchesTaken;
119     my @branchLines;
120
121     my $lines = $class->{"lines"}->{"line"};
122     if (ref($lines) eq "ARRAY") {
123         foreach my $line (@$lines) {
124             addLineCounts($line, \@hits, \@hitLines, \@branchesPossible, \@branchesTaken, \@branchLines);
125         }
126     } else {
127         addLineCounts($lines, \@hits, \@hitLines, \@branchesPossible, \@branchesTaken, \@branchLines);
128     }
129     
130     my $file = {};
131     $file->{"hits"} = \@hits;
132     $file->{"hitLines"} = \@hitLines;
133     $file->{"branchesPossible"} = \@branchesPossible;
134     $file->{"branchesTaken"} = \@branchesTaken;
135     $file->{"branchLines"} = \@branchLines;
136     $file->{"filename"} = substr($class->{"filename"}, length(sourceDir()));
137     $file->{"coverage"} = abs($class->{"line-rate"});
138     if (@branchLines) {
139         $file->{"branchCoverage"} = abs($class->{"branch-rate"});
140     } else {
141         $file->{"branchCoverage"} = 1;
142     }
143     $file->{"totalHeat"} = sum(@hits);
144     $file->{"maxHeat"} = max(@hits);
145     return $file;
146 }
147
148 sub addLineCounts($$$$$$)
149 {
150     my ($line, $hits, $hitLines, $branchesPossible, $branchesTaken, $branchLines) = @_;
151     push(@$hits, int($line->{"hits"}));
152     push(@$hitLines, int($line->{"number"}));
153     if($line->{"branch"} eq "true") {
154     
155         # Extract the numerator and denominator of the condition-coverage attribute, which looks like "75% (3/4)"
156         $line->{"condition-coverage"} =~ /\((.*)\/(.*)\)/;
157         push(@$branchesTaken, int($1));
158         push(@$branchesPossible, int($2));
159         push(@$branchLines, int($line->{"number"}));
160     }
161 }
162
163 sub createResultName()
164 {
165     my $svnVersion = determineCurrentSVNRevision();
166     my @timeData = localtime(time);
167     return $svnVersion . "-" . join('_', @timeData);
168 }