1#! /usr/bin/perl 2 3# Copyright (C) 2003,2008 MySQL AB 4# Copyright (C) 2010,2017 Sergei Golubchik and MariaDB Corporation 5# 6# This program is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License as published by 8# the Free Software Foundation; version 2 of the License. 9# 10# This program is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# GNU General Public License for more details. 14# 15# You should have received a copy of the GNU General Public License 16# along with this program; if not, write to the Free Software 17# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1335 USA 18 19# Run gcov and report test coverage on only those code lines touched by 20# a given list of commits. 21 22use strict; 23use warnings; 24 25use Getopt::Long; 26use File::Find; 27use Cwd qw/realpath/; 28 29my $opt_verbose=0; 30my $opt_generate; 31my $opt_help; 32my $opt_purge; 33my $opt_only_gcov; 34my $opt_skip_gcov; 35 36my %cov; 37my $file_no=0; 38 39GetOptions 40 ("v|verbose+" => \$opt_verbose, 41 "h|help" => \$opt_help, 42 "p|purge" => \$opt_purge, 43 "g|generate" => \$opt_generate, 44 "o|only-gcov" => \$opt_only_gcov, 45 "s|skip-gcov" => \$opt_skip_gcov, 46 ) or usage(); 47 48usage() if $opt_help; 49 50sub logv(@) { print STDERR @_,"\n" if $opt_verbose; } 51sub gcov_prefix($) { defined($_[0]) ? $_[0] || '#####' : '-' } 52 53my $root= `git rev-parse --show-toplevel`; 54chomp $root; 55 56die "Failed to find tree root" unless $root; 57$root=realpath($root).'/'; 58logv "Chdir $root"; 59chdir $root or die "chdir($root): $!"; 60 61my $res; 62my $cmd; 63if ($opt_purge) 64{ 65 $cmd= "find . -name '*.da' -o -name '*.gcda' -o -name '*.gcov' -o ". 66 "-name '*.dgcov' | grep -v 'README\.gcov' | xargs rm -f ''"; 67 logv "Running: $cmd"; 68 system($cmd)==0 or die "system($cmd): $? $!"; 69 exit 0; 70} 71 72find(\&gcov_one_file, $root); 73find(\&write_coverage, $root) if $opt_generate; 74exit 0 if $opt_only_gcov; 75 76if (@ARGV) { 77 print_gcov_for_diff(@ARGV); 78} else { 79 print_gcov_for_diff('HEAD') or print_gcov_for_diff('HEAD^'); 80} 81exit 0; 82 83sub print_gcov_for_diff { 84 $cmd="git diff --no-prefix --ignore-space-change @_"; 85 logv "Running: $cmd"; 86 open PIPE, '-|', $cmd or die "Failed to popen '$cmd': $!: $?"; 87 my ($lnum, $cnt, $fcov, $acc, $printme, $fname); 88 while (<PIPE>) { 89 if (/^diff --git (.*) \1\n/) { 90 print $acc if $printme; 91 $fname=$1; 92 $acc="dgcov $fname"; 93 $acc=('*' x length($acc)) . "\n$acc\n" . ('*' x length($acc)); 94 $lnum=undef; 95 $fcov=$cov{realpath($fname)}; 96 $printme=0; 97 logv "File: $fname"; 98 next; 99 } 100 if (/^@@ -\d+,\d+ \+(\d+),(\d+) @@/ and $fcov) { 101 $lnum=$1; 102 $cnt=$2; 103 $acc.="\n@@ +$lnum,$cnt @\@$'"; 104 logv " lines: $lnum,",$lnum+$cnt; 105 next; 106 } 107 next unless $lnum and $cnt; 108 $acc.=sprintf '%9s:%5s:%s', '', $lnum, $' if /^ /; 109 ++$printme, $acc.=sprintf '%9s:%5s:%s', gcov_prefix($fcov->{$lnum}), $lnum, $' if /^\+/; 110 die "$_^^^ dying", unless /^[- +]/; 111 ++$lnum; 112 --$cnt; 113 } 114 print $acc if $printme; 115 close PIPE or die "command '$cmd' failed: $!: $?"; 116 return defined($fname); 117} 118 119sub usage { 120 print <<END; 121Usage: $0 --help 122 $0 [options] [git diff arguments] 123 124The dgcov program runs gcov for code coverage analysis, and reports missing 125coverage only for those lines that are changed by the specified commit(s). 126Commits are specified in the format of git diff arguments. For example: 127 * All unpushed commits: $0 \@{u} HEAD 128 * All uncommitted changes: $0 HEAD 129 * Specific commit: $0 <commit>^ <commit> 130 131If no arguments are specified, it prints the coverage for all uncommitted 132changes, if any, otherwise for the last commit. 133 134Options: 135 136 -h --help This help. 137 -v --verbose Show commands run. 138 -p --purge Delete all test coverage information, to prepare for a 139 new coverage test. 140 -o --only-gcov Stop after running gcov, don't run git 141 -s --skip-gcov Do not run gcov, assume .gcov files are already in place 142 -g --generate Create .dgcov files for all source files 143 144Prior to running this tool, MariaDB should be built with 145 146 cmake -DENABLE_GCOV=ON 147 148and the testsuite should be run. dgcov will report the coverage 149for all lines modified in the specified commits. 150END 151 152 exit 1; 153} 154 155sub gcov_one_file { 156 return unless /\.gcda$/; 157 unless ($opt_skip_gcov) { 158 $cmd= "gcov -il '$_' 2>/dev/null >/dev/null"; 159 print STDERR ++$file_no,"\r" if not $opt_verbose and -t STDERR; 160 logv "Running: $cmd"; 161 system($cmd)==0 or die "system($cmd): $? $!"; 162 } 163 164 # now, read the generated file 165 for my $gcov_file (<$_*.gcov>) { 166 open FH, '<', "$gcov_file" or die "open(<$gcov_file): $!"; 167 my $fname; 168 while (<FH>) { 169 chomp; 170 if (/^function:/) { 171 next; 172 } 173 if (/^file:/) { 174 $fname=realpath(-f $' ? $' : $root.$'); 175 next; 176 } 177 next if /^lcount:\d+,-\d+/; # whatever that means 178 unless (/^lcount:(\d+),(\d+)/ and $fname) { 179 warn "unknown line '$_' in $gcov_file"; 180 next; 181 } 182 $cov{$fname}->{$1}+=$2; 183 } 184 close(FH); 185 } 186} 187 188sub write_coverage { 189 my $fn=$File::Find::name; 190 my $h=$cov{$fn}; 191 return unless $h and $root eq substr $fn, 0, length($root); 192 open I, '<', $fn or die "open(<$fn): $!"; 193 open O, '>', "$fn.dgcov" or die "open(>$fn.dgcov): $!"; 194 logv "Annotating: ", substr $fn, length($root); 195 while (<I>) { 196 printf O '%9s:%5s:%s', gcov_prefix($h->{$.}), $., $_; 197 } 198 close I; 199 close O; 200} 201