#!/usr/bin/perl

use strict;
use warnings;

package myObj;

sub new {
  my $class = shift;
  my %args = @_;
  my $self = {};
  $self->{ name  } = $args{ name  } || 'default';
  $self->{ value } = $args{ value } || '';
  $self->{ chars } = $args{ chars } || qr/^[a-z]+$/;
  return bless $self, $class;
}

sub set_name  { my $self = shift; $self->{ name  } = shift; return; }
sub set_value { my $self = shift; $self->{ value } = shift; return; }
sub set_chars { my $self = shift; $self->{ chars } = shift; return; }
sub get_name  { my $self = shift; return $self->{ name  }; }
sub get_value { my $self = shift; return $self->{ value }; }
sub get_chars { my $self = shift; return $self->{ chars }; }

package main;

use Test::More tests => 11;

ok( my $obj1 = myObj->new( name => 'test1',
                           value => 'myval',
                           chars => qr/^[0-9]$/
                         ), "can create a myObj specifying values" );
isa_ok( $obj1, 'myObj' );

ok( my $obj2 = myObj->new(), "can create a myObj not specifying values
+" );
isa_ok( $obj2, 'myObj' );

ok( ! $obj2->set_name(  'test1'     ), "can set name"  );
ok( 'test1' eq $obj2->get_name(),      "can get name"  );

ok( ! $obj2->set_value( 'myval'     ), "can set value" );
ok( 'myval' eq $obj2->get_value(),     "can get value" );

ok( ! $obj2->set_chars( qr/^[0-9]$/ ), "can set chars" );
ok( qr/^[0-9]$/ eq $obj2->get_chars(), "can get chars" );

is_deeply( $obj1, $obj2, "obj1 seems deeply similar to obj2" );
[download]

Run via: perl -MDevel::Cover cover.pl, which will dutifully run the test suite (all tests successful). If you quickly eyeball the test code, it seems it exercises all the available code paths. It assigns default values if it doesn't receive values in new(), and the two resultant objects are, as far as is_deeply can tell, identical. However, if we take a closer look at the coverage report:

$ cover
Reading database from /Users/kentcowgill/cover_db

---------------------------- ------ ------ ------ ------ ------ ------
+ ------
File                           stmt   bran   cond    sub    pod   time
+  total
---------------------------- ------ ------ ------ ------ ------ ------
+ ------
cover.pl                      100.0    n/a   85.7  100.0    n/a  100.0
+   98.3
Total                         100.0    n/a   85.7  100.0    n/a  100.0
+   98.3
---------------------------- ------ ------ ------ ------ ------ ------
+ ------
[download]

Huh? I would think that my "condition coverage" would be 100%. Taking a look at the text of the HTML report generated:

line %   coverage    condition
12   100             $args{'name'} || 'default'
         A   dec
         0   0
         1   1
                
13   100             $args{'value'} || ''
         A   dec
         0   0
         1   1

14   67              $args{'chars'} || qr/^[a-z]+$/
         A   B   dec
         0   0   0
         0   1   1
         1   X   1
[download]