xt/moose-does-moo-role.t

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