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 BEGIN {
 141   package Plunk;
 142
 143   use Moo::Role;
 144
 145   has pp => (is => 'rw', moosify => sub {
 146     my $spec = shift;
 147     $spec->{documentation} = 'moosify';
 148   });
 149 }
 150
 151 BEGIN {
 152   package Plank;
 153
 154   use Moo;
 155   use Sub::Quote;
 156
 157   has vv => (is => 'rw', moosify => [quote_sub(q|
 158     $_[0]->{documentation} = 'moosify';
 159   |), sub { $_[0]->{documentation} = $_[0]->{documentation}.' foo'; }]);
 160 }
 161
 162 BEGIN {
 163   package Plunker;
 164
 165   use Moose;
 166
 167   with 'Plunk';
 168 }
 169
 170 BEGIN {
 171   package Planker;
 172
 173   use Moose;
 174
 175   extends 'Plank';
 176 }
 177
 178 BEGIN {
 179   package Plonk;
 180   use Moo;
 181   has kk => (is => 'rw', moosify => [sub {
 182     $_[0]->{documentation} = 'parent';
 183   }]);
 184 }
 185 BEGIN {
 186   package Plonker;
 187   use Moo;
 188   extends 'Plonk';
 189   has '+kk' => (moosify => sub {
 190     my $spec = shift;
 191     $spec->{documentation} .= 'child';
 192   });
 193 }
 194 BEGIN{
 195   local $SIG{__WARN__} = sub { fail "warning: $_[0]" };
 196   package SplatteredMoose;
 197   use Moose;
 198   extends 'Splattered';
 199 }
 200
 201 foreach my $s (
 202     Splattered->new,
 203     Splattered2->new,
 204     Ker::Splattered->new,
 205     Ker::Splattered2->new,
 206     KerSplattered->new,
 207     KerSplattered2->new,
 208     SplatteredMoose->new
 209 ) {
 210   can_ok($s, 'punch')
 211     and is($s->punch, 1, 'punch');
 212   can_ok($s, 'jab')
 213     and is($s->jab, 3, 'jab');
 214   can_ok($s, 'monkey')
 215     and is($s->monkey, 'OW', 'monkey');
 216   can_ok($s, 'trap')
 217     and is($s->trap, -1, 'trap');
 218 }
 219
 220 foreach my $c (qw/
 221     Ker::Splattered
 222     Ker::Splattered2
 223     KerSplattered
 224     KerSplattered2
 225 /) {
 226   can_ok($c, 'has_ker');
 227   can_ok($c, 'has_splat');
 228 }
 229
 230 is(Plunker->meta->find_attribute_by_name('pp')->documentation, 'moosify', 'moosify modifies attr specs');
 231 is(Planker->meta->find_attribute_by_name('vv')->documentation, 'moosify foo', 'moosify modifies attr specs as array');
 232
 233 is( Plonker->meta->find_attribute_by_name('kk')->documentation,
 234     'parentchild',
 235     'moosify applies for overridden attributes with roles');
 236
 237 {
 238   package MooseAttrTrait;
 239   use Moose::Role;
 240
 241   has 'extra_attr' => (is => 'ro');
 242   has 'extra_attr_noinit' => (is => 'ro', init_arg => undef);
 243 }
 244
 245 {
 246   local $SIG{__WARN__} = sub { fail "warning: $_[0]" };
 247   package UsingMooseTrait;
 248   use Moo;
 249
 250   has one => (
 251     is => 'ro',
 252     traits => ['MooseAttrTrait'],
 253     extra_attr => 'one',
 254     extra_attr_noinit => 'two',
 255   );
 256 }
 257
 258 ok( UsingMooseTrait->meta
 259       ->find_attribute_by_name('one')->can('extra_attr'),
 260     'trait was properly applied');
 261 is( UsingMooseTrait->meta->find_attribute_by_name('one')
 262       ->extra_attr,
 263     'one',
 264     'trait attributes maintain values');
 265
 266 done_testing;