Using Roles with Test::Class::Moose

Note: this post assumes you have Test::Class::Moose version 0.06 or higher (on its way to the CPAN now).

By now you may have heard of Test::Class::Moose. I wrote this to solve a need that many people have: they want the awesomeness of Test::Class, but the modern OO facilities of Moose.

Test::Class::Moose isn't for testing Moose classes, it's for testing anything you would have previously used Test::Class for, except that now you get Moosy (Moosee? Moosey?) goodness to go with it. I'll be attending YAPC::NA 2013 in Austin and I've pitched a Test::Class::Moose talk and, even if it doesn't get accepted, I figured I should at least write the slides. One of my most common uses cases (and and itch I always rescratch whenever I use Test::Class, Test::Class::Most or, now, Test::Class::Moose) caused one of my slides to have too much code.

So now it's fixed, released to the CPAN, and available for everyone to tell me it's "too magical" (a complaint I've heard in the past). Here's the problem and how I solved it.

Consider the following minimal class (some boilerplate omitted for brevity):

package Person;
use Moose;

has [ 'first_name', 'last_name' ] => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
);

sub full_name {
    my $self = shift;
    return join ' ' => $self->first_name, $self->last_name;
}

1;

To use any of the Test::Class* modules, you start by writing a base class. Here's what ours looks like:

package My::Test::Class;

use Test::Class::Moose;

INIT {
    Test::Class::Moose->new(
        show_timing => 0,
        randomize   => 0,
        statistics  => 1,
    )->runtests;
}

1;

Note: you don't need to know Test::Class for this example, but if you want to know more, see my (out of date) Test::Class tutorial on Modern Perl Books.

And our actual test class might look like this:

package TestsFor::Person;
use Test::Class::Moose parent => 'My::Test::Class';
use Person;

sub test_constructor {
    my $test = shift;

    ok my $person = Person->new(
        first_name => 'Bob',
        last_name  => 'Dobbs',
    ), 'We should have a test person';

    isa_ok $person, 'Person', '... and the object it returns';
    is $person->full_name, 'Bob Dobbs',
      '... and it should return the correct full name';
}

1;

Running that with prove -lv t/lib/TestsFor/Person.pm generates the following output:

1..2
#
# Running tests for My::Test::Class
#
    1..0 # SKIP Skipping 'My::Test::Class': no test methods found
ok 1 # skip Skipping 'My::Test::Class': no test methods found
#
# Running tests for TestsFor::Person
#
    1..1
    # TestsFor::Person->test_constructor()
        ok 1 - We should be able to create a Person object
        ok 2 - ... and the object it returns isa Person
        ok 3 - ... and it should return the correct full name
        1..3
    ok 1 - test_constructor
ok 2 - TestsFor::Person
# Test classes:    2
# Test methods:    1
# Total tests run: 3
ok
All tests successful.
Files=1, Tests=2,  3 wallclock secs ( 0.03 usr  0.01 sys +  0.46 cusr  0.05 csys =  0.55 CPU)
Result: PASS

So everything looks good so far, but that contains the very common anti-pattern I see in test class tests. Do you see the problem? It's very subtle and we'll see it in a moment.

Let's imagine that we have an employee subclass of person:

package Person::Employee;

use Moose;
extends 'Person';

has 'employee_number' => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
);

1;

A stub test for that could look like this:

package TestsFor::Person::Employee;

use Test::Class::Moose extends => 'TestsFor::Person';
use Person::Employee;

1;

That will actually run tests because we inherit our test_constructor method from TestsFor::Person. Let's see what that looks like:

1..3
#
# Running tests for My::Test::Class
#
    1..0 # SKIP Skipping 'My::Test::Class': no test methods found
ok 1 # skip Skipping 'My::Test::Class': no test methods found
#
# Running tests for TestsFor::Person
#
    1..1
    # TestsFor::Person->test_constructor()
        ok 1 - We should have a test person
        ok 2 - ... and the object it returns isa Person
        ok 3 - ... and it should return the correct full name
        1..3
    ok 1 - test_constructor
ok 2 - TestsFor::Person
#
# Running tests for TestsFor::Person::Employee
#
    1..1
    # TestsFor::Person::Employee->test_constructor()
        ok 1 - We should have a test person
        ok 2 - ... and the object it returns isa Person
        ok 3 - ... and it should return the correct full name
        1..3
    ok 1 - test_constructor
ok 3 - TestsFor::Person::Employee
# Test classes:    3
# Test methods:    2
# Total tests run: 6

Notice how we've inherited the test_constructor test, but it's just a useless double test. We're not actually testing our new class because we hardcoded the Person class name in TestsFor::Person. In fact, I remember one time many years ago when my tests were passing but the package didn't even compile! It turns out that in my test class, I had forgotten to use the package I was testing and my inherited tests had the parent class name hard-coded. I decided to never make that mistake again. Now I have my test classes (usually) automatically load the classes they are going to test.

Annoyingly, automatically using the classes I test is the code I keep rewriting, so now I have created Test::Class::Moose::Role::AutoUse. This role strips the leading segment of the test class package name (TestsFor::, for our examples) and will use the resulting class name and make it available via the class_name() attribute.

Change the base class to look like this:

package My::Test::Class;

use Test::Class::Moose;
with 'Test::Class::Moose::Role::AutoUse';

INIT {
    Test::Class::Moose->new(
        show_timing => 0,
        randomize   => 0,
        statistics  => 1,
    )->runtests;
}

1;

And the TestsFor::Person class now looks like this:

package TestsFor::Person;
use Test::Class::Moose parent => 'My::Test::Class';

sub test_constructor {
    my $test = shift;

    my $class = $test->class_name;
    ok my $person = $class->new(
        first_name => 'Bob',
        last_name  => 'Dobbs',
      ),
      'We should have a test person';

    isa_ok $person, $class, '... and the object it returns';
    is $person->full_name, 'Bob Dobbs',
      '... and it should return the correct full name';
}

1;

Note that we no longer need to use Person and we no longer hard-code the class name.

The TestsFor::Person class tests pass, but TestsFor::Person::Employee now die a horrible death, telling us that that employee_number argument is required for the constructor., even though we've not had to change the code for that class.

In other words, you can no longer forget to use the class under test and, if you don't hard-code the class name, your test inheritance works properly. (Note that I don't often his this bug any more because I avoid inheritance, but I still like that I can automatically use the packages I am testing).

Rather than leave you hanging, here's one way of fixing this:

package TestsFor::Person;
use Test::Class::Moose parent => 'My::Test::Class';

BEGIN { has 'test_person' => ( is => 'rw', isa => 'Person' ); }

sub extra_constructor_args {}

sub test_setup {
    my $test = shift;
    $test->test_person( $test->class_name->new({
        first_name => 'Bob',
        last_name  => 'Dobbs',
        $test->extra_constructor_args,
    }));
}

sub test_constructor {
    my $test = shift;

    ok my $person = $test->test_person, 'We should have a test person';

    isa_ok $person, $test->class_name, '... and the object it returns';
    is $person->full_name, 'Bob Dobbs',
      '... and it should return the correct full name';
}

1;

A few notes about that. First, the test_person attribute is, well, an attribute. Thus, Test::Class::Moose knows that it is not a test method, even though it begins with test_ (all methods beginning with test_ are automatically test methods).

Second, it's wrapped in a BEGIN block due to a subtle bug that crops a few times. In this case, if Moose attributes (and as you'll see later, method modifiers) were built into Perl and fired at compile time, this bug would go away.

Finally, the test_setup method is a test control method which is called before every test method. It ensures that you always have a fresh sample instance of the object you're testing.

Then our subclass looks like this:

package TestsFor::Person::Employee;
use Test::Class::Moose extends => 'TestsFor::Person';

sub extra_constructor_args {
    return ( employee_number => 666 );
}

BEGIN {
    after 'test_constructor' => sub {
        my $test = shift;
        is $test->test_person->employee_number, 666,
          '... and we should get the correct employee number';
    };
}

1;

We have to wrap our method modifier in a BEGIN block due to the bug mentioned earlier. Aside from that, though, you'll note that we extend the parent constructor behavior to only test the new behavior. That helps us avoid duplicated test code.

And the test output:

1..3
#
# Running tests for My::Test::Class
#
    1..0 # SKIP Skipping 'My::Test::Class': no test methods found
ok 1 # skip Skipping 'My::Test::Class': no test methods found
#
# Running tests for TestsFor::Person
#
    1..1
    # TestsFor::Person->test_constructor()
        ok 1 - We should have a test person
        ok 2 - ... and the object it returns isa Person
        ok 3 - ... and it should return the correct full name
        1..3
    ok 1 - test_constructor
ok 2 - TestsFor::Person
#
# Running tests for TestsFor::Person::Employee
#
    1..1
    # TestsFor::Person::Employee->test_constructor()
        ok 1 - We should have a test person
        ok 2 - ... and the object it returns isa Person::Employee
        ok 3 - ... and it should return the correct full name
        ok 4 - ... and we should get the correct employee number
        1..4
    ok 1 - test_constructor
ok 3 - TestsFor::Person::Employee
# Test classes:    3
# Test methods:    2
# Total tests run: 7

Not everyone likes Test::Class and not everyone likes Moose, but if you like both and you want to harness the power of both, it's all there for you. I'd like to find a cleaner way around the BEGIN block issue, but this is a decent start.

Also, if you don't like how the class names are determined with Test::Class::Moose::Role::AutoUse, you can override the get_class_name_to_use method.

Leave a comment

About Ovid

user-pic Have Perl; Will Travel. Freelance Perl/Testing/Agile consultant. Photo by http://www.circle23.com/. Warning: that site is not safe for work. The photographer is a good friend of mine, though, and it's appropriate to credit his work.