X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F030_roles%2F017_extending_role_attrs.t;h=d9b223b0b5a5c4a908a100c4f593e42feadb15ad;hb=bbf62397d81d046a716776f756249e22c4ddf372;hp=4e81d3dc5d1142d7fa9913ab6340f669b270acef;hpb=dd14f8e85f6ff9bbb945b870d6859859261f0e41;p=gitmo%2FMoose.git

diff --git a/t/030_roles/017_extending_role_attrs.t b/t/030_roles/017_extending_role_attrs.t
index 4e81d3d..d9b223b 100644
--- a/t/030_roles/017_extending_role_attrs.t
+++ b/t/030_roles/017_extending_role_attrs.t
@@ -3,16 +3,13 @@
 use strict;
 use warnings;
 
-use Test::More tests => 10;
-use Test::Exception;
+use Test::More;
+use Test::Fatal;
 
-BEGIN {
-    use_ok('Moose');
-}
 
 =pod
 
-This basically just makes sure that using +name 
+This basically just makes sure that using +name
 on role attributes works right.
 
 =cut
@@ -20,21 +17,21 @@ on role attributes works right.
 {
     package Foo::Role;
     use Moose::Role;
-    
+
     has 'bar' => (
         is      => 'rw',
-        isa     => 'Int',   
+        isa     => 'Int',
         default => sub { 10 },
     );
-    
+
     package Foo;
     use Moose;
-    
+
     with 'Foo::Role';
-    
-    ::lives_ok {
+
+    ::is( ::exception {
         has '+bar' => (default => sub { 100 });
-    } '... extended the attribute successfully';  
+    }, undef, '... extended the attribute successfully' );
 }
 
 my $foo = Foo->new;
@@ -42,6 +39,7 @@ isa_ok($foo, 'Foo');
 
 is($foo->bar, 100, '... got the extended attribute');
 
+
 {
     package Bar::Role;
     use Moose::Role;
@@ -56,20 +54,133 @@ is($foo->bar, 100, '... got the extended attribute');
 
     with 'Bar::Role';
 
-    ::lives_ok {
+    ::is( ::exception {
         has '+foo' => (
             isa => 'Int',
         )
-    } "... narrowed the role's type constraint successfully";
+    }, undef, "... narrowed the role's type constraint successfully" );
 }
 
-
 my $bar = Bar->new(foo => 42);
 isa_ok($bar, 'Bar');
 is($bar->foo, 42, '... got the extended attribute');
 $bar->foo(100);
 is($bar->foo, 100, "... can change the attribute's value to an Int");
 
-throws_ok { $bar->foo("baz") } qr/^Attribute \(foo\) does not pass the type constraint because: Validation failed for 'Int' failed with value baz at /;
+like( exception { $bar->foo("baz") }, qr/^Attribute \(foo\) does not pass the type constraint because: Validation failed for 'Int' with value baz at / );
 is($bar->foo, 100, "... still has the old Int value");
 
+
+{
+    package Baz::Role;
+    use Moose::Role;
+
+    has 'baz' => (
+        is      => 'rw',
+        isa     => 'Value',
+    );
+
+    package Baz;
+    use Moose;
+
+    with 'Baz::Role';
+
+    ::is( ::exception {
+        has '+baz' => (
+            isa => 'Int | ClassName',
+        )
+    }, undef, "... narrowed the role's type constraint successfully" );
+}
+
+my $baz = Baz->new(baz => 99);
+isa_ok($baz, 'Baz');
+is($baz->baz, 99, '... got the extended attribute');
+$baz->baz('Foo');
+is($baz->baz, 'Foo', "... can change the attribute's value to a ClassName");
+
+like( exception { $baz->baz("zonk") }, qr/^Attribute \(baz\) does not pass the type constraint because: Validation failed for 'ClassName\|Int' with value zonk at / );
+is_deeply($baz->baz, 'Foo', "... still has the old ClassName value");
+
+
+{
+    package Quux::Role;
+    use Moose::Role;
+
+    has 'quux' => (
+        is      => 'rw',
+        isa     => 'Str | Int | Ref',
+    );
+
+    package Quux;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    with 'Quux::Role';
+
+    subtype 'Positive'
+        => as 'Int'
+        => where { $_ > 0 };
+
+    ::is( ::exception {
+        has '+quux' => (
+            isa => 'Positive | ArrayRef',
+        )
+    }, undef, "... narrowed the role's type constraint successfully" );
+}
+
+my $quux = Quux->new(quux => 99);
+isa_ok($quux, 'Quux');
+is($quux->quux, 99, '... got the extended attribute');
+$quux->quux(100);
+is($quux->quux, 100, "... can change the attribute's value to an Int");
+$quux->quux(["hi"]);
+is_deeply($quux->quux, ["hi"], "... can change the attribute's value to an ArrayRef");
+
+like( exception { $quux->quux("quux") }, qr/^Attribute \(quux\) does not pass the type constraint because: Validation failed for 'ArrayRef\|Positive' with value quux at / );
+is_deeply($quux->quux, ["hi"], "... still has the old ArrayRef value");
+
+like( exception { $quux->quux({a => 1}) }, qr/^Attribute \(quux\) does not pass the type constraint because: Validation failed for 'ArrayRef\|Positive' with value HASH\(\w+\) at / );
+is_deeply($quux->quux, ["hi"], "... still has the old ArrayRef value");
+
+
+{
+    package Err::Role;
+    use Moose::Role;
+
+    for (1..3) {
+        has "err$_" => (
+            isa => 'Str | Int',
+            is => 'bare',
+        );
+    }
+
+    package Err;
+    use Moose;
+
+    with 'Err::Role';
+
+    ::is( ::exception {
+        has '+err1' => (isa => 'Defined');
+    }, undef, "can get less specific in the subclass" );
+
+    ::is( ::exception {
+        has '+err2' => (isa => 'Bool');
+    }, undef, "or change the type completely" );
+
+    ::is( ::exception {
+        has '+err3' => (isa => 'Str | ArrayRef');
+    }, undef, "or add new types to the union" );
+}
+
+{
+    package Role::With::PlusAttr;
+    use Moose::Role;
+
+    with 'Foo::Role';
+
+    ::like( ::exception {
+        has '+bar' => ( is => 'ro' );
+    }, qr/has '\+attr' is not supported in roles/, "Test has '+attr' in roles explodes" );
+}
+
+done_testing;