t/compose-roles.t

   1 use strictures 1;
   2 use Test::More;
   3
   4 {
   5   package One; use Role::Tiny;
   6   around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
   7   package Two; use Role::Tiny;
   8   around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
   9   package Three; use Role::Tiny;
  10   around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
  11   package Four; use Role::Tiny;
  12   around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
  13   package Base; sub foo { __PACKAGE__ }
  14 }
  15
  16 foreach my $combo (
  17   [ qw(One Two Three Four) ],
  18   [ qw(Two Four Three) ],
  19   [ qw(One Two) ]
  20 ) {
  21   my $combined = Role::Tiny->create_class_with_roles('Base', @$combo);
  22   is_deeply(
  23     [ $combined->foo ], [ reverse(@$combo), 'Base' ],
  24     "${combined} ok"
  25   );
  26   my $object = bless({}, 'Base');
  27   Role::Tiny->apply_roles_to_object($object, @$combo);
  28   is(ref($object), $combined, 'Object reblessed into correct class');
  29 }
  30
  31 {
  32   package RoleWithAttr;
  33   use Moo::Role;
  34
  35   has attr1 => (is => 'rw');
  36
  37   package RoleWithAttr2;
  38   use Moo::Role;
  39
  40   has attr2 => (is => 'rw');
  41
  42   package ClassWithAttr;
  43   use Moo;
  44
  45   has attr3 => (is => 'rw');
  46 }
  47
  48 Moo::Role->apply_roles_to_package('ClassWithAttr', 'RoleWithAttr', 'RoleWithAttr2');
  49 my $o = ClassWithAttr->new(attr1 => 1, attr2 => 2, attr3 => 3);
  50 is($o->attr1, 1, 'attribute from role works');
  51 is($o->attr2, 2, 'attribute from role 2 works');
  52 is($o->attr3, 3, 'attribute from base class works');
  53
  54 done_testing;