Back in the Moose Track

It figured it out day here in the Moose-Pen

Well I really should bow my head in shame again as I got the whole Devel::Cover concept backwards. I thought that changing the code in my application would change the results of cover. Well I was dead wrong on that some further reading on my part and a few more test runs of cover I finally figured out that;

line %  coverage branch
94  50  T  F        if $self->gather
for this sub

sub gather_count{
            my $self = shift;
            return 1
              if ($self->gather());
            }
means that my TESTS only cover 50% of the above code. According to the colours I have one test that covers the false condition and no test for the true. Looking at my test suite for the offending 'gather_count' it is true I only use it once in the '37_gathers.t' test case;

ok(!$dad->gather_count, "No Gathers on $type");
So I added in one more test a little earlier in the test;

ok($dad->gather_count == 1,"Should be 1");
and on the next run of cover I get 82.5% coverage and all green for line 34

line %  coverage branch
94  100  T  F    if $self->gather
Bingo now I know how it works. Hitting the next 5 items on the list should be easy. The next almost identical code the first example this time it was the 'dynamic_gather_count' So I added two new test for that one as both where failing

line %  coverage branch
94   0  T  F    if $self->dynamic_gather
The final thee where similar so I will only look at one in detail

confess( $self->meta->get_attribute('no_create')->description->{message} )
    if ( $self->no_create() );
So I need to add in three fail checks to cover these three I guess I forgot to do them before. To get all three I just add this little bit of code to the '20_dad_load.t' test case

 $in_hash =    { view => { name => 'person' },
                   elements=>[{ name => 'street', view => 'person', }],
                   delete_requires_condition=>0,
                   update_requires_condition=>0, };
                   
my $errors = {update   =>"Attempt to use update with no_update flag on",
              create   =>"Attempt to use create with no_create flag on",
              retrieve =>"Attempt to use retrieve with no_retrieve flag on"};
    
    foreach my $key (sort(keys(%{$errors}))){
        $in_hash->{"no_".$key} = 1;
        $da_new = Database::Accessor->new($in_hash);
        like( exception {$da_new->$key(Data::Test->new(),{})},
    qr /$errors->{$key}/,
    "no_.$key flag error on $key"
);
delete( $in_hash->{"no_".$key});

}


Which should do the trick.
On my next cover run I get;


File:  lib/Database/Accessor.pm Coverage: 95.0%
Adding those few tests cleaned up almost of of the coverage but the real bonus is those last three tests has shown up potential bug in my system as two of the new tests

…
ok 91 - da_result_class has to be a valid Class in the path
not ok 92 - no_create flag error on create
ok 93 - no_retrieve flag error on retrieve
not ok 94 - no_update flag error on update
are failing.

So I there you have Devel::Cover really works wonders once you figure out how it works. I even have a but for tomorrow's post;

The only thing left is this sub

       sub get_element_by_lookup {
           my $self = shift;
           my ($lookup) = @_;
           my $found = $self->_get_element_by_lookup(sub { if (ref($_) ne 'Database::Accessor::Element' or !defined($_->_lookup_name)) {return 0} $_->_lookup_name eq $lookup});
           return $found;
        }
which is reporting a 67% coverage and I can see the details of that I am only testing one of the conditions So I will have to add in a test that has a ref that is not a 'Element' class and has no _lookup_name defined. I did look about in my code and to my surprise I do not have a test for get_element_by_lookup or get_element_by_name so perhapse just a quick test of each??

my $element = $da_new->get_element_by_name('street');
ok(ref($element) eq 'Database::Accessor::Element','got an element by name');
$element = $da_new->get_element_by_lookup("personstreet");
ok(ref($element) eq 'Database::Accessor::Element','got an element by lookup');
After adding those two I still was stuck at 95% so I think I will ccept that for now.

oh-no-no-no-moose-here.jpg


Leave a comment

About byterock

user-pic Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations