皆様、ユニットテストのカバレッジは計測していますでしょうか?シャノンでは主に Perl を開発言語として使っているため、Devel::Cover を使ってカバレッジを計測しています。また、製品のリリース前には必ずカバレッジを計測することになっているため、Jenkins に過去のカバレッジが保存されています。
さて、つい先日、カバレッジの推移を見ていた所、こんなことが起きていました。
リリースごとの変更分はかなり量があるので、ソースやテストコードを見ながらカバレッジを下がった原因を特定するのは困難です。そこで、過去のカバレッジと比較することで変化を見てみました。こんな感じです。
gist(シャノンではソースコード管理に GitHub Enterprise を利用しています)に、tsv 形式でアップしています。自動的に表形式になってくれるので便利です。「(down)」など文字列を入れてフィルタリングもできます。
あとはカバレッジの下がったところや新規のカバレッジの低いところを中心に直していけばよいわけです。
カバレッジの HTML をパースして tsv を作成するのは、以下のような雑なスクリプトでやっています。(深遠な事情により、結構古い Devel::Cover を使っているので最近のバージョンだとうまく取れないかもしれません。そもそも、最近の Devel::Cover であれば JSON 出力などもできるので、そちらを使ったほうが便利かつ簡単でしょう)
#!/usr/bin/env perl
use strict;
use warnings;
use LWP::Simple;
use HTML::TreeBuilder::XPath;
use HTML::Selector::XPath 'selector_to_xpath';
use List::MoreUtils qw(uniq);
main();
exit 0;
sub main {
my $url1 = $ARGV[0];
my $url2 = $ARGV[1];
if ( !defined $url1 || !defined $url2 ) {
die "比較対象のURLを指定してください\n";
}
my $coverage_html1 = fetch_contents($url1);
my $coverage_html2 = fetch_contents($url2);
my %coverage_for_file1 = parse_coverage($coverage_html1);
my %coverage_for_file2 = parse_coverage($coverage_html2);
my @files = uniq(keys %coverage_for_file1, keys %coverage_for_file2);
print "file\tbefore(%)\tafter(%)\tstatus\n";
for my $file ( sort @files ) {
my $coverage_before = $coverage_for_file1{$file} // '-';
my $coverage_after = $coverage_for_file2{$file} // '-';
my $status = get_status($coverage_before, $coverage_after);
if ( $coverage_before ne $coverage_after ) {
print "$file\t$coverage_before\t$coverage_after\t$status\n";
}
}
}
sub get_status {
my ($before, $after) = @_;
if ( $before eq '-' ) {
return '(new)';
}
if ( $after eq '-' ) {
return '(removed)';
}
if ( $before > $after ) {
return '(down)';
}
return '';
}
sub parse_coverage {
my ($html) = @_;
my $tree = HTML::TreeBuilder::XPath->new;
$tree->parse($html);
my @tables = $tree->findnodes(selector_to_xpath('html body table'));
my $coverage_table = $tables[1];
my @table_rows = $coverage_table->find_by_tag_name('tr');
shift @table_rows; #タイトル行は不要
pop @table_rows; #total の行は不要
my %result = ();
for my $row ( @table_rows ) {
my @columns = $row->find_by_tag_name('td');
my $file = $columns[0];
my $total = $columns[7];
next if ( !defined $file );
next if ( !defined $total );
#カバレッジは プロジェクト名/lib/プロジェクト名/... となるので先頭のプロジェクト名を削除
my $filename = $file->as_text;
$filename =~ s{^.+?/}{};
$result{$filename} = $total->as_text;
}
return %result;
}
sub fetch_contents {
my ($url) = @_;
my $result = get($url);
if ( !defined $url ) {
die "can't fetch $url";
}
return $result;
}
pull request にフックしてチェックとか、やっても良いのですが手間のわりに得られるものも少なそうですし、あまり「カバレッジ警察」みたいなことをするのも精神衛生上よくないと思うので、このくらいが手軽で妥当かな、と思っています。