Moose Test 9-5

So today I am going to follow along from my last post and come up with a little better way to test my Database::Accessor::Roles::DAD role.

This stems from my mistake of the other day of not addng in the 'Collections' attribute to my “Database::Accessor::Roles::DAD” role. Now the purpose of this Role is to supply all the necessary objects from my down into the various DADs so it is importat that I pass that along.

So I guess my first test is to check that I have my Role in correct shape. A simple use ok will do that, but what I want is a way to test that all my attributes are present in a DAD. Now this is when the Meta-data part of Moose really comes into its own. All I need to do is;

my @attributes = $address->meta->get_all_attributes;

and I get a list of all the attributes in a Moose Class. Then I can use them to test against my Database::Accessor::Roles::DAD role.

Now only if it was as simple as that. Roles are notoriously tricky to test but lets walk though what I have so far and see. First what I have to do is create a Test package to load in my 'Database::Accessor::Roles::DAD' and if I am going to do that I might as well create a new 06_roles.t file for it.

So to start;

package Test;
use Moose;
sub new {
my $class = shift;
my $self = {};
bless( $self, ( ref($class) || $class ) );
return( $self );
sub DB_Class{
return 1;
sub Execute {
return 1;

Note I added in the two subs that I know that any class consuming my role will require. Next is the normal Testing broiler plate, so no need to see that, and at the end of that I have;

use Moose::Util qw(apply_all_roles);

Now for my first tests. I want to see if I can use my role but I just can't do a


as I have bundled the above role in the file so I have to use that first for my tests to run.


Now a few quick news to create an instance of the Test package and an instance of Accessor;

my $test = Test->new();
my $accessor = Database::Accessor->new();

Next I use the Moose::Util 'apply_all_roles' to add in my role to $test and at the same time I wrap this in a eval so I can test the apply worked;

eval {
apply_all_roles( $test, "Database::Accessor::Roles::DAD");
if ($@) {
fail("Can not apply role 'Database::Accessor::Roles::DAD'; errr=$@");
else {
pass("Can apply role 'Database::Accessor::Roles::DAD");

Now the fun bit;

foreach my $attribute ($accessor->meta->get_all_attributes){
if (index($attribute->name(),'_') eq 0);
my $dad_attribute = ucfirst($attribute->name());
ok($test->can($dad_attribute),"Role DAD can $dad_attribute")

In the above I am iterating over all the attributes of my Accossor instance. I reject any that start with “_” as these are private. Then I uppercase the first letter of the attribute name and finish off with with a simple 'can' test on my Test package instance. I run my test and get;
# Failed test 'Role DAD can Conditions'
# at 06_Roles.t line 52.
# Looks like you failed 1 test of 6.
ok 1 - use Database::Accessor;
ok 2 - use Database::Accessor::Roles::DAD;
ok 3 - Can apply role 'Database::Accessor::Roles::DAD
not ok 4 - Role DAD can Conditions
ok 5 - Role DAD can View
ok 6 - Role DAD can Elements

So my role is missing Conditions. I add that in and re-run and I get

ok 1 - use Database::Accessor;
ok 2 - use Database::Accessor::Roles::DAD;
ok 3 - Can apply role 'Database::Accessor::Roles::DAD
ok 4 - Role DAD can Conditions
ok 5 - Role DAD can View
ok 6 - Role DAD can Elements

So now I have a test that will stop me from making that same mistake again.

Now just a side note for you testing nerds out there, my test should never assume that I the number of attributes on a Accessor object is a know so I dropped the ' tests => ' from the Test::More use and instead I use 'done_testing()' at the end to clean things up for me.

For you spelling nerds out there I did another dyslexia boo-boo and had 'condtions' instead of 'conditions' I cleaned this up as well. I could if I wanted to do a spell check on the '$dad_attribute' but that may be a little overkill.


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