t/role-basic-composition.t

   1 #!/usr/bin/env perl
   2
   3 use lib 'lib', 't/role-basic/lib';
   4 use MyTests;
   5 require Role::Tiny;
   6
   7 {
   8
   9     package My::Does::Basic1;
  10     use Role::Tiny;
  11     requires 'turbo_charger';
  12
  13     sub method {
  14         return __PACKAGE__ . " method";
  15     }
  16 }
  17 {
  18
  19     package My::Does::Basic2;
  20     use Role::Tiny;
  21     requires 'turbo_charger';
  22
  23     sub method2 {
  24         return __PACKAGE__ . " method2";
  25     }
  26 }
  27
  28 eval <<'END_PACKAGE';
  29 package My::Class1;
  30 use Role::Tiny 'with';
  31 with qw(
  32     My::Does::Basic1
  33     My::Does::Basic2
  34 );
  35 sub turbo_charger {}
  36 END_PACKAGE
  37 ok !$@, 'We should be able to use two roles with the same requirements'
  38     or die $@;
  39
  40 {
  41
  42     package My::Does::Basic3;
  43     use Role::Tiny;
  44     with 'My::Does::Basic2';
  45
  46     sub method3 {
  47         return __PACKAGE__ . " method3";
  48     }
  49 }
  50
  51 eval <<'END_PACKAGE';
  52 package My::Class2;
  53 use Role::Tiny 'with';
  54 with qw(
  55     My::Does::Basic3
  56 );
  57 sub new { bless {} => shift }
  58 sub turbo_charger {}
  59 END_PACKAGE
  60 ok !$@, 'We should be able to use roles which consume roles'
  61     or die $@;
  62 can_ok 'My::Class2', 'method2';
  63 is My::Class2->method2, 'My::Does::Basic2 method2',
  64   '... and it should be the correct method';
  65 can_ok 'My::Class2', 'method3';
  66 is My::Class2->method3, 'My::Does::Basic3 method3',
  67   '... and it should be the correct method';
  68
  69 ok My::Class2->Role::Tiny::does_role('My::Does::Basic3'), 'A class DOES roles which it consumes';
  70 ok My::Class2->Role::Tiny::does_role('My::Does::Basic2'),
  71   '... and should do roles which its roles consumes';
  72 ok !My::Class2->Role::Tiny::does_role('My::Does::Basic1'),
  73   '... but not roles which it never consumed';
  74
  75 my $object = My::Class2->new;
  76 ok $object->Role::Tiny::does_role('My::Does::Basic3'), 'An instance DOES roles which its class consumes';
  77 ok $object->Role::Tiny::does_role('My::Does::Basic2'),
  78   '... and should do roles which its roles consumes';
  79 ok !$object->Role::Tiny::does_role('My::Does::Basic1'),
  80   '... but not roles which it never consumed';
  81
  82 {
  83     {
  84         package Role::Which::Imports;
  85         use Role::Tiny allow => 'TestMethods';
  86         use TestMethods qw(this that);
  87     }
  88     {
  89        package Class::With::ImportingRole;
  90        use Role::Tiny 'with';
  91        with 'Role::Which::Imports';
  92        sub new { bless {} => shift }
  93     }
  94     my $o = Class::With::ImportingRole->new;
  95
  96     foreach my $method (qw/this that/) {
  97         can_ok $o, $method;
  98         ok $o->$method($method), '... and calling "allow"ed methods should succeed';
  99         is $o->$method, $method, '... and it should function correctly';
 100     }
 101 }
 102
 103 {
 104     {
 105         package Role::WithImportsOnceRemoved;
 106         use Role::Tiny;
 107         with 'Role::Which::Imports';
 108     }
 109     {
 110         package Class::With::ImportingRole2;
 111         use Role::Tiny 'with';
 112 $ENV{DEBUG} = 1;
 113         with 'Role::WithImportsOnceRemoved';
 114         sub new { bless {} => shift }
 115     }
 116     ok my $o = Class::With::ImportingRole2->new,
 117         'We should be able to use roles which compose roles which import';
 118
 119     foreach my $method (qw/this that/) {
 120         can_ok $o, $method;
 121         ok $o->$method($method), '... and calling "allow"ed methods should succeed';
 122         is $o->$method, $method, '... and it should function correctly';
 123     }
 124 }
 125
 126 {
 127         {
 128                 package Method::Role1;
 129                 use Role::Tiny;
 130                 sub method1 { }
 131                 requires 'method2';
 132         }
 133
 134         {
 135                 package Method::Role2;
 136                 use Role::Tiny;
 137                 sub method2 { }
 138                 requires 'method1';
 139         }
 140         my $success = eval q{
 141                 package Class;
 142                 use Role::Tiny::With;
 143                 with 'Method::Role1', 'Method::Role2';
 144                 1;
 145         };
 146         is $success, 1, 'composed mutually dependent methods successfully' or diag "Error: $@";
 147 }
 148
 149 {
 150         {
 151                 package Modifier::Role1;
 152                 use Moo::Role;
 153                 sub foo {
 154                 }
 155                 before 'bar', sub {};
 156         }
 157
 158         {
 159                 package Modifier::Role2;
 160                 use Moo::Role;
 161                 sub bar {
 162                 }
 163                 before 'foo', sub {};
 164         }
 165         my $success = eval q{
 166                 package Class;
 167                 use Moo;
 168                 with 'Modifier::Role1', 'Modifier::Role2';
 169                 1;
 170         };
 171         is $success, 1, 'composed mutually dependent modifiers successfully' or diag "Error: $@";
 172 }
 173
 174 done_testing;