xt/moo-does-moose-role.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Fatal;
   4
   5 BEGIN {
   6   package Ker;
   7
   8   use Moo::Role;
   9
  10   sub has_ker {}
  11 }
  12
  13 BEGIN {
  14   package Splat;
  15
  16   use Moose::Role;
  17
  18   requires 'monkey';
  19
  20   sub punch { 1 }
  21
  22   sub jab { 0 }
  23
  24   around monkey => sub { 'OW' };
  25
  26   has trap => (is => 'ro', default => sub { -1 });
  27
  28   sub has_splat {}
  29 }
  30
  31 BEGIN {
  32     package KerSplat;
  33     use Moo::Role;
  34
  35     with qw/
  36         Ker
  37         Splat
  38     /;
  39 }
  40
  41 BEGIN {
  42   package Splat2;
  43
  44   use Mouse::Role;
  45
  46   requires 'monkey';
  47
  48   sub punch { 1 }
  49
  50   sub jab { 0 }
  51
  52   around monkey => sub { 'OW' };
  53
  54   has trap => (is => 'ro', default => sub { -1 });
  55
  56   sub has_splat {}
  57 }
  58
  59 BEGIN {
  60     package KerSplat2;
  61     use Moo::Role;
  62
  63     with qw/
  64         Ker
  65         Splat2
  66     /;
  67 }
  68
  69 BEGIN {
  70   package Splattered;
  71
  72   use Moo;
  73
  74   sub monkey { 'WHAT' }
  75
  76   with 'Splat';
  77
  78   sub jab { 3 }
  79 }
  80
  81 BEGIN {
  82   package Splattered2;
  83
  84   use Moo;
  85
  86   sub monkey { 'WHAT' }
  87
  88   with 'Splat2';
  89
  90   sub jab { 3 }
  91 }
  92
  93 BEGIN {
  94   package Ker::Splattered;
  95
  96   use Moo;
  97
  98   sub monkey { 'WHAT' }
  99
 100   with qw/ Ker Splat /;
 101
 102   sub jab { 3 }
 103 }
 104
 105 BEGIN {
 106   package Ker::Splattered2;
 107
 108   use Moo;
 109
 110   sub monkey { 'WHAT' }
 111
 112   with qw/ Ker Splat2 /;
 113
 114   sub jab { 3 }
 115 }
 116
 117 BEGIN {
 118   package KerSplattered;
 119
 120   use Moo;
 121
 122   sub monkey { 'WHAT' }
 123
 124   with qw/ KerSplat /;
 125
 126   sub jab { 3 }
 127 }
 128
 129 BEGIN {
 130   package KerSplattered2;
 131
 132   use Moo;
 133
 134   sub monkey { 'WHAT' }
 135
 136   with qw/ KerSplat2 /;
 137
 138   sub jab { 3 }
 139 }
 140
 141 BEGIN {
 142   package Plunk;
 143
 144   use Moo::Role;
 145
 146   has pp => (is => 'rw', moosify => sub {
 147     my $spec = shift;
 148     $spec->{documentation} = 'moosify';
 149   });
 150 }
 151
 152 BEGIN {
 153   package Plank;
 154
 155   use Moo;
 156   use Sub::Quote;
 157
 158   has vv => (is => 'rw', moosify => [quote_sub(q|
 159     $_[0]->{documentation} = 'moosify';
 160   |), sub { $_[0]->{documentation} = $_[0]->{documentation}.' foo'; }]);
 161 }
 162
 163 BEGIN {
 164   package Plunker;
 165
 166   use Moose;
 167
 168   with 'Plunk';
 169 }
 170
 171 BEGIN {
 172   package Planker;
 173
 174   use Moose;
 175
 176   extends 'Plank';
 177 }
 178
 179 BEGIN {
 180   package Plonk;
 181   use Moo;
 182   has kk => (is => 'rw', moosify => [sub {
 183     $_[0]->{documentation} = 'parent';
 184   }]);
 185 }
 186 BEGIN {
 187   package Plonker;
 188   use Moo;
 189   extends 'Plonk';
 190   has '+kk' => (moosify => sub {
 191     my $spec = shift;
 192     $spec->{documentation} .= 'child';
 193   });
 194 }
 195 BEGIN{
 196   local $SIG{__WARN__} = sub { fail "warning: $_[0]" };
 197   package SplatteredMoose;
 198   use Moose;
 199   extends 'Splattered';
 200 }
 201
 202 foreach my $s (
 203     Splattered->new,
 204     Splattered2->new,
 205     Ker::Splattered->new,
 206     Ker::Splattered2->new,
 207     KerSplattered->new,
 208     KerSplattered2->new,
 209     SplatteredMoose->new
 210 ) {
 211   can_ok($s, 'punch')
 212     and is($s->punch, 1, 'punch');
 213   can_ok($s, 'jab')
 214     and is($s->jab, 3, 'jab');
 215   can_ok($s, 'monkey')
 216     and is($s->monkey, 'OW', 'monkey');
 217   can_ok($s, 'trap')
 218     and is($s->trap, -1, 'trap');
 219 }
 220
 221 foreach my $c (qw/
 222     Ker::Splattered
 223     Ker::Splattered2
 224     KerSplattered
 225     KerSplattered2
 226 /) {
 227   can_ok($c, 'has_ker');
 228   can_ok($c, 'has_splat');
 229 }
 230
 231 is(Plunker->meta->find_attribute_by_name('pp')->documentation, 'moosify', 'moosify modifies attr specs');
 232 is(Planker->meta->find_attribute_by_name('vv')->documentation, 'moosify foo', 'moosify modifies attr specs as array');
 233
 234 is( Plonker->meta->find_attribute_by_name('kk')->documentation,
 235     'parentchild',
 236     'moosify applies for overridden attributes with roles');
 237
 238 {
 239   package MooseAttrTrait;
 240   use Moose::Role;
 241
 242   has 'extra_attr' => (is => 'ro');
 243   has 'extra_attr_noinit' => (is => 'ro', init_arg => undef);
 244 }
 245
 246 {
 247   local $SIG{__WARN__} = sub { fail "warning: $_[0]" };
 248   package UsingMooseTrait;
 249   use Moo;
 250
 251   has one => (
 252     is => 'ro',
 253     traits => ['MooseAttrTrait'],
 254     extra_attr => 'one',
 255     extra_attr_noinit => 'two',
 256   );
 257 }
 258
 259 ok( UsingMooseTrait->meta
 260       ->find_attribute_by_name('one')->can('extra_attr'),
 261     'trait was properly applied');
 262 is( UsingMooseTrait->meta->find_attribute_by_name('one')
 263       ->extra_attr,
 264     'one',
 265     'trait attributes maintain values');
 266
 267 {
 268   package NeedTrap;
 269   use Moo::Role;
 270
 271   requires 'trap';
 272 }
 273
 274 is exception {
 275   package Splattrap;
 276   use Moo;
 277   sub monkey {}
 278
 279   with qw(Splat NeedTrap);
 280 }, undef, 'requires satisfied by Moose attribute composed at the same time';
 281
 282 {
 283   package HasMonkey;
 284   use Moo;
 285   sub monkey {}
 286 }
 287 is exception {
 288   Moo::Role->create_class_with_roles('HasMonkey', 'Splat', 'NeedTrap');
 289 }, undef, ' ... and when created by create_class_with_roles';
 290
 291 done_testing;