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   around foo => sub { my $orig = shift; join ' ', 'role foo', $orig->(@_) };
  14
  15   sub bar { 'role bar' }
  16
  17   sub baz { 'role baz' }
  18 }
  19
  20 BEGIN {
  21   package MyClass;
  22
  23   use constant SIMPLE => 'simple';
  24   use constant REF_CONST => [ 'ref_const' ];
  25   use constant VSTRING_CONST => v1;
  26
  27   sub req1 { }
  28   sub req2 { }
  29   sub foo { 'class foo' }
  30   sub baz { 'class baz' }
  31
  32 }
  33
  34 BEGIN {
  35   package ExtraClass;
  36   sub req1 { }
  37   sub req2 { }
  38   sub req3 { }
  39   sub foo { }
  40   sub baz { 'class baz' }
  41 }
  42
  43 BEGIN {
  44   package IntermediaryRole;
  45   use Role::Tiny;
  46   requires 'req3';
  47 }
  48
  49 BEGIN {
  50   package NoMethods;
  51
  52   package OneMethod;
  53
  54   sub req1 { }
  55 }
  56
  57 BEGIN {
  58   package ExtraRole;
  59   use Role::Tiny;
  60
  61   sub extra1 { 'role extra' }
  62 }
  63
  64 BEGIN {
  65   package BrokenRole;
  66   use Role::Tiny;
  67
  68   around 'broken modifier' => sub { my $orig = shift; $orig->(@_) };
  69 }
  70
  71 sub try_apply_to {
  72   my $to = shift;
  73   exception { Role::Tiny->apply_role_to_package($to, 'MyRole') }
  74 }
  75
  76 is(try_apply_to('MyClass'), undef, 'role applies cleanly');
  77 is(MyClass->foo, 'role foo class foo', 'method modifier');
  78 is(MyClass->bar, 'role bar', 'method from role');
  79 is(MyClass->baz, 'class baz', 'method from class');
  80 ok(MyClass->does('MyRole'), 'class does role');
  81 ok(!MyClass->does('IntermediaryRole'), 'class does not do non-applied role');
  82 ok(!MyClass->does('Random'), 'class does not do non-role');
  83
  84 like(try_apply_to('NoMethods'), qr/req1, req2/, 'error for both methods');
  85 like(try_apply_to('OneMethod'), qr/req2/, 'error for one method');
  86
  87 is exception {
  88   Role::Tiny->apply_role_to_package('IntermediaryRole', 'MyRole');
  89   Role::Tiny->apply_role_to_package('ExtraClass', 'IntermediaryRole');
  90 }, undef, 'No errors applying roles';
  91
  92 ok(ExtraClass->does('MyRole'), 'ExtraClass does MyRole');
  93 ok(ExtraClass->does('IntermediaryRole'), 'ExtraClass does IntermediaryRole');
  94 is(ExtraClass->bar, 'role bar', 'method from role');
  95 is(ExtraClass->baz, 'class baz', 'method from class');
  96
  97 my $new_class;
  98 is exception {
  99     $new_class = Role::Tiny->create_class_with_roles('MyClass', 'ExtraRole');
 100 }, undef, 'No errors creating class with roles';
 101
 102 isa_ok($new_class, 'MyClass');
 103 is($new_class->extra1, 'role extra', 'method from role');
 104
 105 ok(exception {
 106     $new_class = Role::Tiny->create_class_with_roles('MyClass', 'BrokenRole');
 107 }, 'exception caught creating class with broken modifier in a role');
 108
 109 done_testing;
 110