Perl Advent Calendar 2006-12-21

Warm, Fuzzy Coverage

by David Westbrook & Jerrad Pierce

Ever wonder what parts of your code are actually used? Perhaps to see what can be thrown away when refactoring? Or better still, to determine how thorough your test suite is? Devel::Cover will answer all of those questions and many more ¹ by providing code coverage metrics. In short, this means you can get pretty HTML tables showing you what percent of subroutines, branches, statements, and conditions are being executed. Let's take a look at the coverage of a small snippet that uses a hypothetical Acme::Santa module.

my %list = ( David => [ 'White Christmas', 'Candy Cane' ] );
my $Santa = Acme::Santa->new();
$Santa->make_a_list( %list );
$Santa->check_it_twice;

So how much of Acme::Santa does this really use? To find out, we can inspect our script by executing it under Devel::Cover:

# Clear the default database 'cover_db' to remove stats from any prior run
$ cover -delete -silent
# Options to only collect stats for Acme::* and use the default db
$ perl -MDevel::Cover=-ignore,.,-select,Acme snippet.pl
# Simple console coverage report
$ cover

File                                  stmt   bran   cond    sub   time  total
----------------------------------- ------ ------ ------ ------ ------ ------
Acme/Santa.pm                         72.4   50.0   40.0   66.7  100.0   65.2

That's not too impressive, our little script doesn't seem to exercise the module very well. But what exactly aren't we using? Luckily, we installed the optional prerequisites and Devel::Cover generated a pretty HTML report for us to show-off and examine (below). The sub coverage section indicates that two routines were missed completely. The entire file coverage section highlights specific statements that were missed, such as line 29 and lines 38-41. They were never reached because previous conditions were not met.

But our snippet is intended to be simple, and has no need for gravity-defying caribou. So what good is this? Well, we all know test suites are important for verifying that the code functions as intended. Coverage statistics are just as important in determining whether the test suite is probing every aspect of the code. So, what if we wanted to adapt our snippet for use as a part of Acme::Santa's test suite? We might end up with something like the following, which gets us 100% coverage on all fronts:

my %list = (
  David      => [ 'White Christmas' ],
  Grinch     => [ 'Christmas Theft' ],
  Satan      => [ 'Fire', 'Brimestome' ],
  'Dr. Evil' => [ 'World Domination' ],
);
my %list2 = (
  David      => [ 'Candy Cane' ],
);

my $Santa = Acme::Santa->new;
$Santa->make_a_list( %list );
$Santa->make_a_list( %list2 );
$Santa->check_it_twice;
$Santa->make_toys;
$Santa->fly_reindeer;

Could we verify that this test script, or some combination of scripts in our test suite results in total test coverage without running each manually? To merge these two worlds, you can can generate coverage statistics for modules that are not yet installed from their build directories from the t/*.t test suite² with the following:

# Clear the default database 'cover_db' to remove stats from any prior run
$ cover -delete
$ make test HARNESS_PERL_SWITCHES=-MDevel::Cover…

Acme::Santa

   1 package Acme::Santa;
   2 use strict;
   3 use warnings;
   4 
   5 use constant NAUGHTY => 0;
   6 use constant NICE    => 1;
   7 
   8 sub new {
   9   my $self = shift;
  10   bless { _list=>{} }, $self;
  11 }
  12 
  13 sub make_a_list {
  14   my $self = shift;
  15   my %list = @_;
  16   my $ct = 0;
  17   while( my ($k, $v) = each %list ){
  18     $ct += @$v;
  19     $self->{_list}->{$k} ||= [];
  20     push @{$self->{_list}->{$k}}, @$v;
  21   }
  22   return $ct;
  23 }
  24 
  25 sub check_it_twice {
  26   my $self = shift;
  27   while( my ($who, $list) = each %{$self->{_list}} ){
  28     unless ( $self->_is_naughty_or_nice($who) == NICE ){
  29       $_ = 'coal' for @$list;
  30     }
  31   }
  32 }
  33 
  34 sub _is_naughty_or_nice {
  35   my $self = shift;
  36   my $who = shift;
  37   if( $who =~ /\bevil\b/i || $who =~ /\bsatan\b/i){
  38     return NAUGHTY;
  39   }elsif( $who =~ /\bgrinch\b/i ){
  40     sleep 1;
  41     return NAUGHTY;
  42   }
  43   return NICE;
  44 }
  45 
  46 sub make_toys    { my $self = shift; }
  47 sub fly_reindeer { my $self = shift; }
  48 
  49 1;

SEE ALSO

FOOTNOTES

1. Code taking forever to run when it should be speedy? Not sure if you documented everything? Devel::Cover performs some limited profiling and the results are included by the "time" column in portions of the coverage report. Also, if Pod::Coverage is installed then Devel::Cover will also include statistics about the kwalitee of the documentation coverage as well.

2. Support for other frameworks exists as well.