no automatic travis testing for wip/blocked branches

[gitmo/Moo.git] / xt / moo-does-moose-role.t

diff --git a/xt/moo-does-moose-role.t b/xt/moo-does-moose-role.t
index 9f5c25d..b995e44 100644 (file)
--- a/xt/moo-does-moose-role.t
+++ b/xt/moo-does-moose-role.t
@@ -1,5 +1,14 @@
 use strictures 1;
 use Test::More;
+use Test::Fatal;
+
+BEGIN {
+  package Ker;
+
+  use Moo::Role;
+
+  sub has_ker {}
+}
 
 BEGIN {
   package Splat;
@@ -15,6 +24,18 @@ BEGIN {
   around monkey => sub { 'OW' };
 
   has trap => (is => 'ro', default => sub { -1 });
+
+  sub has_splat {}
+}
+
+BEGIN {
+    package KerSplat;
+    use Moo::Role;
+
+    with qw/
+        Ker
+        Splat
+    /;
 }
 
 BEGIN {
@@ -31,6 +52,18 @@ BEGIN {
   around monkey => sub { 'OW' };
 
   has trap => (is => 'ro', default => sub { -1 });
+
+  sub has_splat {}
+}
+
+BEGIN {
+    package KerSplat2;
+    use Moo::Role;
+
+    with qw/
+        Ker
+        Splat2
+    /;
 }
 
 BEGIN {
@@ -57,11 +90,202 @@ BEGIN {
   sub jab { 3 }
 }
 
-foreach my $s (Splattered->new, Splattered2->new) {
-  is($s->punch, 1, 'punch');
-  is($s->jab, 3, 'jab');
-  is($s->monkey, 'OW', 'monkey');
-  is($s->trap, -1, 'trap');
+BEGIN {
+  package Ker::Splattered;
+
+  use Moo;
+
+  sub monkey { 'WHAT' }
+
+  with qw/ Ker Splat /;
+
+  sub jab { 3 }
+}
+
+BEGIN {
+  package Ker::Splattered2;
+
+  use Moo;
+
+  sub monkey { 'WHAT' }
+
+  with qw/ Ker Splat2 /;
+
+  sub jab { 3 }
+}
+
+BEGIN {
+  package KerSplattered;
+
+  use Moo;
+
+  sub monkey { 'WHAT' }
+
+  with qw/ KerSplat /;
+
+  sub jab { 3 }
+}
+
+BEGIN {
+  package KerSplattered2;
+
+  use Moo;
+
+  sub monkey { 'WHAT' }
+
+  with qw/ KerSplat2 /;
+
+  sub jab { 3 }
+}
+
+BEGIN {
+  package Plunk;
+
+  use Moo::Role;
+
+  has pp => (is => 'rw', moosify => sub {
+    my $spec = shift;
+    $spec->{documentation} = 'moosify';
+  });
+}
+
+BEGIN {
+  package Plank;
+
+  use Moo;
+  use Sub::Quote;
+
+  has vv => (is => 'rw', moosify => [quote_sub(q|
+    $_[0]->{documentation} = 'moosify';
+  |), sub { $_[0]->{documentation} = $_[0]->{documentation}.' foo'; }]);
+}
+
+BEGIN {
+  package Plunker;
+
+  use Moose;
+
+  with 'Plunk';
+}
+
+BEGIN {
+  package Planker;
+
+  use Moose;
+
+  extends 'Plank';
+}
+
+BEGIN {
+  package Plonk;
+  use Moo;
+  has kk => (is => 'rw', moosify => [sub {
+    $_[0]->{documentation} = 'parent';
+  }]);
+}
+BEGIN {
+  package Plonker;
+  use Moo;
+  extends 'Plonk';
+  has '+kk' => (moosify => sub {
+    my $spec = shift;
+    $spec->{documentation} .= 'child';
+  });
+}
+BEGIN{
+  local $SIG{__WARN__} = sub { fail "warning: $_[0]" };
+  package SplatteredMoose;
+  use Moose;
+  extends 'Splattered';
+}
+
+foreach my $s (
+    Splattered->new,
+    Splattered2->new,
+    Ker::Splattered->new,
+    Ker::Splattered2->new,
+    KerSplattered->new,
+    KerSplattered2->new,
+    SplatteredMoose->new
+) {
+  can_ok($s, 'punch')
+    and is($s->punch, 1, 'punch');
+  can_ok($s, 'jab')
+    and is($s->jab, 3, 'jab');
+  can_ok($s, 'monkey')
+    and is($s->monkey, 'OW', 'monkey');
+  can_ok($s, 'trap')
+    and is($s->trap, -1, 'trap');
+}
+
+foreach my $c (qw/
+    Ker::Splattered
+    Ker::Splattered2
+    KerSplattered
+    KerSplattered2
+/) {
+  can_ok($c, 'has_ker');
+  can_ok($c, 'has_splat');
+}
+
+is(Plunker->meta->find_attribute_by_name('pp')->documentation, 'moosify', 'moosify modifies attr specs');
+is(Planker->meta->find_attribute_by_name('vv')->documentation, 'moosify foo', 'moosify modifies attr specs as array');
+
+is( Plonker->meta->find_attribute_by_name('kk')->documentation,
+    'parentchild',
+    'moosify applies for overridden attributes with roles');
+
+{
+  package MooseAttrTrait;
+  use Moose::Role;
+
+  has 'extra_attr' => (is => 'ro');
+  has 'extra_attr_noinit' => (is => 'ro', init_arg => undef);
+}
+
+{
+  local $SIG{__WARN__} = sub { fail "warning: $_[0]" };
+  package UsingMooseTrait;
+  use Moo;
+
+  has one => (
+    is => 'ro',
+    traits => ['MooseAttrTrait'],
+    extra_attr => 'one',
+    extra_attr_noinit => 'two',
+  );
+}
+
+ok( UsingMooseTrait->meta
+      ->find_attribute_by_name('one')->can('extra_attr'),
+    'trait was properly applied');
+is( UsingMooseTrait->meta->find_attribute_by_name('one')
+      ->extra_attr,
+    'one',
+    'trait attributes maintain values');
+
+{
+  package NeedTrap;
+  use Moo::Role;
+
+  requires 'trap';
+}
+
+is exception {
+  package Splattrap;
+  use Moo;
+  sub monkey {}
+
+  with qw(Splat NeedTrap);
+}, undef, 'requires satisfied by Moose attribute composed at the same time';
+
+{
+  package HasMonkey;
+  use Moo;
+  sub monkey {}
 }
+is exception {
+  Moo::Role->create_class_with_roles('HasMonkey', 'Splat', 'NeedTrap');
+}, undef, ' ... and when created by create_class_with_roles';
 
 done_testing;