Generate coverage statistics for Erlang/OTP VM (BEAM)

beam-coverage.pl

#!/usr/bin/perl -w
use strict;
use warnings;

# Usage:
# Make sure lcov is installed and is in your path:
#
#   Ubuntu: sudo aptitude install lcov
#
# Ensure ERL_TOP variable is set
#
#   cd <otp-git-repo>
#   export ERL_TOP=`pwd`
#
# Build Erlang/OTP as normal.
# Then, head down to the emulator directory and build gcov
#
#     cd $ERL_TOP/erts/emulator
#     make gcov FLAVOR=smp
#
# Here we assume that the smp flavor should be used, if not
# change $flavor to "opt".
#
# You need to start Erlang with gcov flag
#
#     $ERL_TOP/bin/cerl -gcov
# 
# Yep, that's cerl with a 'c'
#
# Run your tests then run this script:
#
#     ./beam-coverage.pl <directory>
#
# Address your browser to <directory>/index.html

my $outdir = shift;

die "usage: $0 out-directory\r\n" unless defined $outdir;

my $srcdir    = $ENV{"ERL_TOP"};
my $flavor    = "smp";

my $geninfo   = "geninfo --no-checksum --base-directory";
my $genhtml   = "genhtml";

# src paths

my $emu_src_path  = "$srcdir/erts/emulator";
my $elib_src_path = "$srcdir/erts/lib_src";
my $pcre_src_path = "$emu_src_path";

# obj paths

my $emu_obj_path  = <$emu_src_path/obj/*-linux-*/gcov/$flavor>;
my $elib_obj_path = <$elib_src_path/obj/*-linux-*/gcov>;
my $pcre_obj_path = <$emu_src_path/pcre/obj/*-linux-*/gcov>;

# info files

my $emu_info  = "$srcdir/emulator-cover.info";
my $elib_info = "$srcdir/elib-cover.info";
my $pcre_info = "$srcdir/pcre-cover.info";

my $infofiles = "$emu_info $elib_info $pcre_info";

# generation commands

my $gen_emu_info  = "$geninfo $emu_src_path  -o $emu_info  $emu_obj_path";
my $gen_elib_info = "$geninfo $elib_src_path -o $elib_info $elib_obj_path";
my $gen_pcre_info = "$geninfo $pcre_src_path -o $pcre_info $pcre_obj_path";

my $gen_tot_html = "$genhtml -o $outdir $infofiles";

# ... and then we do it, generate data that is ...

run("$gen_emu_info");
run("$gen_elib_info");
run("$gen_pcre_info");
run("$gen_tot_html");

sub run {
  my $cmd = shift;
  print "Command: $cmd\n";
  system("$cmd 2>&1") == 0 or error("\nCan't run \"$cmd\": $?");
}

sub error {
  my $msg = shift;
  print STDERR "Badness: $msg\r\n";
}