t/role-tiny.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Fatal;
   4
   5 BEGIN {
   6   package MyRole;
   7
   8   use Role::Tiny;
   9
  10   requires qw(req1 req2);
  11
  12   around foo => sub { my $orig = shift; join ' ', 'role foo', $orig->(@_) };
  13
  14   sub bar { 'role bar' }
  15
  16   sub baz { 'role baz' }
  17 }
  18
  19 BEGIN {
  20   package MyClass;
  21
  22   use constant SIMPLE => 'simple';
  23   use constant REF_CONST => [ 'ref_const' ];
  24   use constant VSTRING_CONST => v1;
  25
  26   sub req1 { }
  27   sub req2 { }
  28   sub foo { 'class foo' }
  29   sub baz { 'class baz' }
  30
  31 }
  32
  33 BEGIN {
  34   package ExtraClass;
  35   sub req1 { }
  36   sub req2 { }
  37   sub req3 { }
  38   sub foo { }
  39   sub baz { 'class baz' }
  40 }
  41
  42 BEGIN {
  43   package IntermediaryRole;
  44   use Role::Tiny;
  45   requires 'req3';
  46 }
  47
  48 BEGIN {
  49   package NoMethods;
  50
  51   package OneMethod;
  52
  53   sub req1 { }
  54 }
  55
  56 sub try_apply_to {
  57   my $to = shift;
  58   exception { Role::Tiny->apply_role_to_package($to, 'MyRole') }
  59 }
  60
  61 is(try_apply_to('MyClass'), undef, 'role applies cleanly');
  62 is(MyClass->foo, 'role foo class foo', 'method modifier');
  63 is(MyClass->bar, 'role bar', 'method from role');
  64 is(MyClass->baz, 'class baz', 'method from class');
  65 ok(MyClass->does('MyRole'), 'class does role');
  66 ok(!MyClass->does('Random'), 'class does not do non-role');
  67
  68 like(try_apply_to('NoMethods'), qr/req1, req2/, 'error for both methods');
  69 like(try_apply_to('OneMethod'), qr/req2/, 'error for one method');
  70
  71 is exception {
  72   Role::Tiny->apply_role_to_package('IntermediaryRole', 'MyRole');
  73   Role::Tiny->apply_role_to_package('ExtraClass', 'IntermediaryRole');
  74 }, undef, 'No errors applying roles';
  75
  76 ok(ExtraClass->does('MyRole'), 'ExtraClass does MyRole');
  77 ok(ExtraClass->does('IntermediaryRole'), 'ExtraClass does IntermediaryRole');
  78 is(ExtraClass->bar, 'role bar', 'method from role');
  79 is(ExtraClass->baz, 'class baz', 'method from class');
  80
  81 done_testing;
  82