t/compose-roles.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Fatal;
   4
   5 {
   6   package One; use Role::Tiny;
   7   around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
   8   package Two; use Role::Tiny;
   9   around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
  10   package Three; use Role::Tiny;
  11   around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
  12   package Four; use Role::Tiny;
  13   around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
  14   package Base; sub foo { __PACKAGE__ }
  15 }
  16
  17 foreach my $combo (
  18   [ qw(One Two Three Four) ],
  19   [ qw(Two Four Three) ],
  20   [ qw(One Two) ]
  21 ) {
  22   my $combined = Role::Tiny->create_class_with_roles('Base', @$combo);
  23   is_deeply(
  24     [ $combined->foo ], [ reverse(@$combo), 'Base' ],
  25     "${combined} ok"
  26   );
  27   my $object = bless({}, 'Base');
  28   Role::Tiny->apply_roles_to_object($object, @$combo);
  29   is(ref($object), $combined, 'Object reblessed into correct class');
  30 }
  31
  32 {
  33   package RoleWithAttr;
  34   use Moo::Role;
  35
  36   has attr1 => (is => 'ro', default => -1);
  37
  38   package RoleWithAttr2;
  39   use Moo::Role;
  40
  41   has attr2 => (is => 'ro', default => -2);
  42
  43   package ClassWithAttr;
  44   use Moo;
  45
  46   has attr3 => (is => 'ro', default => -3);
  47 }
  48
  49 Moo::Role->apply_roles_to_package('ClassWithAttr', 'RoleWithAttr', 'RoleWithAttr2');
  50 my $o = ClassWithAttr->new(attr1 => 1, attr2 => 2, attr3 => 3);
  51 is($o->attr1, 1, 'attribute from role works');
  52 is($o->attr2, 2, 'attribute from role 2 works');
  53 is($o->attr3, 3, 'attribute from base class works');
  54
  55 {
  56   package SubClassWithoutAttr;
  57   use Moo;
  58   extends 'ClassWithAttr';
  59 }
  60
  61 my $o2 = Moo::Role->create_class_with_roles(
  62   'SubClassWithoutAttr', 'RoleWithAttr')->new;
  63 is($o2->attr3, -3, 'constructor includes base class');
  64 is($o2->attr2, -2, 'constructor includes role');
  65
  66 {
  67   package AccessorExtension;
  68   use Moo::Role;
  69   around 'generate_method' => sub {
  70     my $orig = shift;
  71     my $me = shift;
  72     my ($into, $name) = @_;
  73     $me->$orig(@_);
  74     no strict 'refs';
  75     *{"${into}::_${name}_marker"} = sub { };
  76   };
  77 }
  78
  79 {
  80   package RoleWithReq;
  81   use Moo::Role;
  82   requires '_attr1_marker';
  83 }
  84
  85 is exception {
  86   package EmptyClass;
  87   use Moo;
  88   Moo::Role->apply_roles_to_object(
  89     Moo->_accessor_maker_for(__PACKAGE__),
  90     'AccessorExtension');
  91
  92   with qw(RoleWithAttr RoleWithReq);
  93 }, undef, 'apply_roles_to_object correctly calls accessor generator';
  94
  95 done_testing;