xt/moo-does-moose-role.t

   1 use strictures 1;
   2 use Test::More;
   3
   4 BEGIN {
   5   package Ker;
   6
   7   use Moo::Role;
   8
   9   sub has_ker {}
  10 }
  11
  12 BEGIN {
  13   package Splat;
  14
  15   use Moose::Role;
  16
  17   requires 'monkey';
  18
  19   sub punch { 1 }
  20
  21   sub jab { 0 }
  22
  23   around monkey => sub { 'OW' };
  24
  25   has trap => (is => 'ro', default => sub { -1 });
  26
  27   sub has_splat {}
  28 }
  29
  30 BEGIN {
  31     package KerSplat;
  32     use Moo::Role;
  33
  34     with qw/
  35         Ker
  36         Splat
  37     /;
  38 }
  39
  40 BEGIN {
  41   package Splat2;
  42
  43   use Mouse::Role;
  44
  45   requires 'monkey';
  46
  47   sub punch { 1 }
  48
  49   sub jab { 0 }
  50
  51   around monkey => sub { 'OW' };
  52
  53   has trap => (is => 'ro', default => sub { -1 });
  54
  55   sub has_splat {}
  56 }
  57
  58 BEGIN {
  59     package KerSplat2;
  60     use Moo::Role;
  61
  62     with qw/
  63         Ker
  64         Splat2
  65     /;
  66 }
  67
  68 BEGIN {
  69   package Splattered;
  70
  71   use Moo;
  72
  73   sub monkey { 'WHAT' }
  74
  75   with 'Splat';
  76
  77   sub jab { 3 }
  78 }
  79
  80 BEGIN {
  81   package Splattered2;
  82
  83   use Moo;
  84
  85   sub monkey { 'WHAT' }
  86
  87   with 'Splat2';
  88
  89   sub jab { 3 }
  90 }
  91
  92 BEGIN {
  93   package Ker::Splattered;
  94
  95   use Moo;
  96
  97   sub monkey { 'WHAT' }
  98
  99   with qw/ Ker Splat /;
 100
 101   sub jab { 3 }
 102 }
 103
 104 BEGIN {
 105   package Ker::Splattered2;
 106
 107   use Moo;
 108
 109   sub monkey { 'WHAT' }
 110
 111   with qw/ Ker Splat2 /;
 112
 113   sub jab { 3 }
 114 }
 115
 116 BEGIN {
 117   package KerSplattered;
 118
 119   use Moo;
 120
 121   sub monkey { 'WHAT' }
 122
 123   with qw/ KerSplat /;
 124
 125   sub jab { 3 }
 126 }
 127
 128 BEGIN {
 129   package KerSplattered2;
 130
 131   use Moo;
 132
 133   sub monkey { 'WHAT' }
 134
 135   with qw/ KerSplat2 /;
 136
 137   sub jab { 3 }
 138 }
 139
 140 foreach my $s (
 141     Splattered->new,
 142     Splattered2->new,
 143     Ker::Splattered->new,
 144     Ker::Splattered2->new,
 145     KerSplattered->new,
 146     KerSplattered2->new,
 147 ) {
 148   ok($s->can('punch'))
 149     and is($s->punch, 1, 'punch');
 150   ok($s->can('jab'))
 151     and is($s->jab, 3, 'jab');
 152   ok($s->can('monkey'))
 153     and is($s->monkey, 'OW', 'monkey');
 154   ok($s->can('trap'))
 155     and is($s->trap, -1, 'trap');
 156 }
 157
 158 foreach my $c (qw/
 159     Ker::Splattered
 160     Ker::Splattered2
 161     KerSplattered
 162     KerSplattered2
 163 /) {
 164   ok $c->can('has_ker');
 165   ok $c->can('has_splat');
 166 }
 167
 168 done_testing;
 169