The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Sweet::Meta::Class;
BEGIN {
  $Test::Sweet::Meta::Class::VERSION = '0.03';
}
# ABSTRACT: metaclass role that provides methods for keeping track of tests
use Moose::Role;
use MooseX::Types::Moose qw(Str ArrayRef ClassName Object);
use Test::Sweet::Meta::Method;
use Moose::Meta::Class;
use List::MoreUtils qw(uniq);

use namespace::autoclean;

has 'local_tests' => (
    traits     => ['Array'],
    is         => 'ro',
    isa        => ArrayRef[Str],
    required   => 1,
    default    => sub { [] },
    auto_deref => 1,
    handles    => {
        '_add_test' => 'push',
    }
);

has 'test_metaclass' => (
    is         => 'ro',
    isa        => Object,
    lazy_build => 1,
);

has 'test_metamethod_roles' => (
    is         => 'ro',
    isa        => ArrayRef[ClassName],
    required   => 1,
    default    => sub { ['Test::Sweet::Meta::Method'] },
);

sub _build_test_metaclass {
    my $self = shift;
    return Moose::Meta::Class->create_anon_class(
        superclasses => [ $self->method_metaclass ],
        roles        => $self->test_metamethod_roles,
        cache        => 1,
    );
}

sub add_test {
    my ($self, $name, $code, $test_traits) = @_;
    my $body = $self->test_metaclass->name->wrap(
        $code,
        requested_test_traits => $test_traits || [],
        original_body         => $code,
        name                  => $name,
        package_name          => $self->name,
    );

    $self->add_method( $name, $body );
    $self->_add_test ( $name );
}

# ensure that we get the role's tests (they are available via the MOP, of course)
after 'add_role' => sub {
    my ($self, $role) = @_;
    if ( $role->can('local_tests') ) {
        $self->_add_test($role->local_tests);
    }
};

sub get_all_tests {
    my $self = shift;
    return $self->local_tests unless $self->can('linearized_isa');

    my @ordering = reverse $self->linearized_isa;
    my @tests = map {
        eval {
            my $meta = $_->meta;
            $meta->local_tests;
        };
    } @ordering;

    return uniq @tests;
}

1;



=pod

=head1 NAME

Test::Sweet::Meta::Class - metaclass role that provides methods for keeping track of tests

=head1 VERSION

version 0.03

=head1 METHODS

=head2 get_all_tests

Returns the names of all test methods in this class' hierarchy.

=head2 local_tests

Returns the names of the test methods defined in this class.  Includes
tests composed in via roles.

=head1 AUTHOR

Jonathan Rockway <jrockway@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Jonathan Rockway.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__