A++ Moose

Still in cover mode here in the Moose-Pen

I found another sub that was not being tested seem I never call 'da_warn' in my tests.

This one is a little special;

        sub da_warn {
           my $self       = shift;
           my ($package, $filename, $line) = caller();
           my ($sub,$message) =  @_;
           warn("$package->$sub(), line:$line, $message");
           
        }
it is in 'Database::Accessor::Roles::Driver' so not really part of Database::Accessor but as it is in the Accessor.pm file I think it should be tested. I have to set it up first by adding this line into the 'Database::Accessor::Driver::Test' class;

sub execute {
    my $self = shift;
    my ($result, $type, $conn, $container, $opt ) = @_;
    
    $result->processed_container($self->_get_processed_container($container));
    $result->effected(10);
    $result->query($type.' Query');
    $result->set([9,8,7,6,5,4,3,2,1,0]);
    $result->DB('Data::Test');
    $result->error($self);      
++  $self->da_warn( 'execute', "Tests DA warning sub" )
++    if ( $self->da_warning() >= 1);
    return $result;
}
and then in good old '20_dad_load.t' I add in this test;

like(
     warning { $da_new->retrieve(Data::Test->new()) },
    qr/Tests DA warning sub/,
    'got a warning from dad()',
);
The above uses 'Test::Warning' for this in the same way one uses 'Test::Fatal' a neat package that I intend to use even more.

Poking about in the rest of the code I noticed one other sub that was causing me grief 'get_element_by_name' on line 109 but I could see nothing wrong with it except it was failing 100% and when I search about in the code a little more I found a second copy of the same sub on line 475.

The first failing on was found in a role the second one (which was passing) was found in the body of the package. Normally when you redefine a sub twice in perl you will get a warning but in this instance as I was using Moose the Role just overwrote the sub. Nothing wrong with that but in this case I can just take that extra sub out of the Database::Accessor class.

When I rerun my tests and cover I get 100%, well actually 98.8% as I am still have that problem with this sub;


my $found = $self->_get_element_by_lookup(sub { if (ref($_) ne 'Database::Accessor::Element' or !defined($_->_lookup_name)) {return 0} $_->_lookup_name eq $lookup}); 
not getting to the second part of the if the '!defined($_->_lookup_name)' so not getting that 1.2% which I really want.

I did a good review of the code and that second part of that if is not really needed anymore so I took that out and now I am getting 100% end to end.

I was going to look at the other less than perfect scores for 'Accessor.pm' but after the last test run I am getting 100% in all but POD so I will move onto the next class with problems 'Database::Accessor::Types;'

The only thing I think I can fix up in that class is this portion of the '_element_coerce' sub;


 elsif ( exists( $hash->{ifs} ) ) {
        die "Attribute (ifs) does not pass the type constraint because: 
            Validation failed for 'ArrayRefofThens' with less than 2 ifs"
          if (  exists( $hash->{ifs} )
            and ref( $hash->{ifs} ) eq 'ARRAY'
            and scalar( @{ $hash->{ifs} } < 2 ) );
        $class = "Database::Accessor::If";
    }
as I know I do not do a test for this error condition. Looking at the above I can adjust it a little as I have the exists($hash->{ifs}) twice I only need in the first if.

After taking that out and adding in one more test my coverage now stands at 95% so not bad. I might have to be satisfied with that for now.

Womens-Dont-Moose-With-Me-Womens-Long-Sleeve-Crusher-Vee_56850_2_lg.png

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