t/role-tiny.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3 use Test::More;
   4 use Test::Fatal;
   5
   6 BEGIN {
   7   package MyRole;
   8
   9   use Role::Tiny;
  10
  11   requires qw(req1 req2);
  12
  13   sub bar { 'role bar' }
  14
  15   sub baz { 'role baz' }
  16 }
  17
  18 BEGIN {
  19   package MyClass;
  20
  21   use constant SIMPLE => 'simple';
  22   use constant REF_CONST => [ 'ref_const' ];
  23   use constant VSTRING_CONST => v1;
  24
  25   sub req1 { }
  26   sub req2 { }
  27   sub foo { 'class foo' }
  28   sub baz { 'class baz' }
  29
  30 }
  31
  32 BEGIN {
  33   package ExtraClass;
  34   sub req1 { }
  35   sub req2 { }
  36   sub req3 { }
  37   sub foo { }
  38   sub baz { 'class baz' }
  39 }
  40
  41 BEGIN {
  42   package IntermediaryRole;
  43   use Role::Tiny;
  44   requires 'req3';
  45 }
  46
  47 BEGIN {
  48   package NoMethods;
  49
  50   package OneMethod;
  51
  52   sub req1 { }
  53 }
  54
  55 BEGIN {
  56   package ExtraRole;
  57   use Role::Tiny;
  58
  59   sub extra1 { 'role extra' }
  60 }
  61
  62 sub try_apply_to {
  63   my $to = shift;
  64   exception { Role::Tiny->apply_role_to_package($to, 'MyRole') }
  65 }
  66
  67 is(try_apply_to('MyClass'), undef, 'role applies cleanly');
  68 is(MyClass->bar, 'role bar', 'method from role');
  69 is(MyClass->baz, 'class baz', 'method from class');
  70 ok(MyClass->does('MyRole'), 'class does role');
  71 ok(!MyClass->does('IntermediaryRole'), 'class does not do non-applied role');
  72 ok(!MyClass->does('Random'), 'class does not do non-role');
  73
  74 like(try_apply_to('NoMethods'), qr/req1, req2/, 'error for both methods');
  75 like(try_apply_to('OneMethod'), qr/req2/, 'error for one method');
  76
  77 is exception {
  78   Role::Tiny->apply_role_to_package('IntermediaryRole', 'MyRole');
  79   Role::Tiny->apply_role_to_package('ExtraClass', 'IntermediaryRole');
  80 }, undef, 'No errors applying roles';
  81
  82 ok(ExtraClass->does('MyRole'), 'ExtraClass does MyRole');
  83 ok(ExtraClass->does('IntermediaryRole'), 'ExtraClass does IntermediaryRole');
  84 is(ExtraClass->bar, 'role bar', 'method from role');
  85 is(ExtraClass->baz, 'class baz', 'method from class');
  86
  87 my $new_class;
  88 is exception {
  89     $new_class = Role::Tiny->create_class_with_roles('MyClass', 'ExtraRole');
  90 }, undef, 'No errors creating class with roles';
  91
  92 isa_ok($new_class, 'MyClass');
  93 is($new_class->extra1, 'role extra', 'method from role');
  94
  95 ok(Role::Tiny->is_role('MyRole'), 'is_role true for roles');
  96 ok(!Role::Tiny->is_role('MyClass'), 'is_role false for classes');
  97
  98
  99 done_testing;
 100