xt/moose-does-moo-role.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Exception;
   4
   5 use Moo::HandleMoose;
   6
   7 {
   8    package MooParentRole;
   9    use Moo::Role;
  10    sub parent_role_method { 1 };
  11
  12    package MooRole;
  13    use Moo::Role;
  14    with 'MooParentRole';
  15    sub role_method { 1 };
  16
  17    package MooRoledMooClass;
  18    use Moo;
  19    with 'MooRole';
  20
  21    has 'some_attr' => (is => 'ro');
  22
  23    package MooRoledMooseClass;
  24    use Moose;
  25    with 'MooRole';
  26
  27    has 'some_attr' => (is => 'ro');
  28
  29    package MooseParent;
  30    use Moose;
  31
  32    has e => (
  33       is       => 'ro',
  34       required => 1,
  35       does     => 'MooRole',
  36    );
  37
  38    package MooParent;
  39    use Moo;
  40
  41    has e => (
  42       is       => 'ro',
  43       required => 1,
  44       does     => 'MooRole',
  45    );
  46 }
  47
  48 for my $parent (qw(MooseParent MooParent)) {
  49    for my $child (qw(MooRoledMooClass MooRoledMooseClass)) {
  50       lives_and {
  51          my $o = $parent->new(
  52             e => $child->new(),
  53          );
  54          ok( $o->e->does("MooParentRole"), "$child does parent MooRole" );
  55          can_ok( $o->e, "role_method" );
  56          can_ok( $o->e, "parent_role_method" );
  57          ok($o->e->meta->has_method('role_method'), 'Moose knows about role_method');
  58          ok($o->e->meta->has_method('parent_role_method'), 'Moose knows about parent_role_method');
  59       };
  60    }
  61 }
  62
  63 done_testing;