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    package MooRoledMooseClass;
  22    use Moose;
  23    with 'MooRole';
  24
  25    package MooseParent;
  26    use Moose;
  27
  28    has e => (
  29       is       => 'ro',
  30       required => 1,
  31       does     => 'MooRole',
  32    );
  33
  34    package MooParent;
  35    use Moo;
  36
  37    has e => (
  38       is       => 'ro',
  39       required => 1,
  40       does     => 'MooRole',
  41    );
  42 }
  43
  44 for my $parent (qw(MooseParent MooParent)) {
  45    for my $child (qw(MooRoledMooClass MooRoledMooseClass)) {
  46       lives_and {
  47          my $o = $parent->new(
  48             e => $child->new(),
  49          );
  50          ok( $o->e->does("MooParentRole"), "$child does parent MooRole" );
  51          can_ok( $o->e, "role_method" );
  52          local $TODO = "multi-level roles are broken with moose" if $child eq "MooRoledMooseClass";
  53          can_ok( $o->e, "parent_role_method" );
  54       } "$parent instantiated with a $child delegate that does a MooRole";
  55    }
  56 }
  57
  58 done_testing;