X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F030_roles%2F003_apply_role.t;h=b31caf165d38af95f6135f4cd77167d1675065ed;hb=be0ed15704fdad5f2d8517380a6f24687432c1dd;hp=d1058684ef76ea42f2e0d2a951e3fc646a93d2d5;hpb=dfc199d466d13d1dc91a52fb9a820b49fa97ec7e;p=gitmo%2FMoose.git

diff --git a/t/030_roles/003_apply_role.t b/t/030_roles/003_apply_role.t
index d105868..b31caf1 100644
--- a/t/030_roles/003_apply_role.t
+++ b/t/030_roles/003_apply_role.t
@@ -3,157 +3,193 @@
 use strict;
 use warnings;
 
-use Test::More tests => 86;
-use Test::Exception;
+use Test::More;
+use Test::Fatal;
 
 {
     package FooRole;
     use Moose::Role;
-    
-    has 'bar' => (is => 'rw', isa => 'FooClass');
-    has 'baz' => (is => 'ro');    
-    
-    sub goo { 'FooRole::goo' }
-    sub foo { 'FooRole::foo' }
-    
-    override 'boo' => sub { 'FooRole::boo -> ' . super() };   
-    
-    around 'blau' => sub {  
+
+    our $VERSION = 23;
+
+    has 'bar' => ( is => 'rw', isa => 'FooClass' );
+    has 'baz' => ( is => 'ro' );
+
+    sub goo {'FooRole::goo'}
+    sub foo {'FooRole::foo'}
+
+    override 'boo' => sub { 'FooRole::boo -> ' . super() };
+
+    around 'blau' => sub {
         my $c = shift;
         'FooRole::blau -> ' . $c->();
-    }; 
+    };
+}
 
-}{
+{
     package BarRole;
     use Moose::Role;
-    sub woot { 'BarRole::woot' }
- 
-}{
+    sub woot {'BarRole::woot'}
+}
+
+{
     package BarClass;
     use Moose;
-    
-    sub boo { 'BarClass::boo' }
-    sub foo { 'BarClass::foo' }  # << the role overrides this ...  
 
-    __PACKAGE__->meta->make_immutable(debug => 0);
-}{
-    
+    sub boo {'BarClass::boo'}
+    sub foo {'BarClass::foo'}    # << the role overrides this ...
+}
+
+{
     package FooClass;
     use Moose;
-    
+
     extends 'BarClass';
-       with 'FooRole';
-    
-    sub blau { 'FooClass::blau' } # << the role wraps this ...
-
-    sub goo { 'FooClass::goo' }  # << overrides the one from the role ... 
-    
-    __PACKAGE__->meta->make_immutable(debug => 0);
-}{
-    
+
+    ::like ::exception { with 'FooRole' => { -version => 42 } },
+        qr/FooRole version 42 required--this is only version 23/,
+        'applying role with unsatisfied version requirement';
+
+    ::ok ! ::exception { with 'FooRole' => { -version => 13 } },
+        'applying role with satisfied version requirement';
+
+    sub blau {'FooClass::blau'}    # << the role wraps this ...
+
+    sub goo {'FooClass::goo'}      # << overrides the one from the role ...
+}
+
+{
     package FooBarClass;
     use Moose;
-    
+
     extends 'FooClass';
-       with 'FooRole', 'BarRole';
+    with 'FooRole', 'BarRole';
 }
 
 my $foo_class_meta = FooClass->meta;
-isa_ok($foo_class_meta, 'Moose::Meta::Class');
+isa_ok( $foo_class_meta, 'Moose::Meta::Class' );
 
 my $foobar_class_meta = FooBarClass->meta;
-isa_ok($foobar_class_meta, 'Moose::Meta::Class');
-
-dies_ok {
-    $foo_class_meta->does_role()
-} '... does_role requires a role name';
-
-dies_ok {
-    $foo_class_meta->apply_role()
-} '... apply_role requires a role';
-
-dies_ok {
-    $foo_class_meta->apply_role(bless({} => 'Fail'))
-} '... apply_role requires a role';
-
-ok($foo_class_meta->does_role('FooRole'), '... the FooClass->meta does_role FooRole');
-ok(!$foo_class_meta->does_role('OtherRole'), '... the FooClass->meta !does_role OtherRole');
-
-ok($foobar_class_meta->does_role('FooRole'), '... the FooBarClass->meta does_role FooRole');
-ok($foobar_class_meta->does_role('BarRole'), '... the FooBarClass->meta does_role BarRole');
-ok(!$foobar_class_meta->does_role('OtherRole'), '... the FooBarClass->meta !does_role OtherRole');
+isa_ok( $foobar_class_meta, 'Moose::Meta::Class' );
+
+ok exception {
+    $foo_class_meta->does_role();
+},
+'... does_role requires a role name';
+
+ok exception {
+    $foo_class_meta->add_role();
+},
+'... apply_role requires a role';
+
+ok exception {
+    $foo_class_meta->add_role( bless( {} => 'Fail' ) );
+},
+'... apply_role requires a role';
+
+ok( $foo_class_meta->does_role('FooRole'),
+    '... the FooClass->meta does_role FooRole' );
+ok( !$foo_class_meta->does_role('OtherRole'),
+    '... the FooClass->meta !does_role OtherRole' );
+
+ok( $foobar_class_meta->does_role('FooRole'),
+    '... the FooBarClass->meta does_role FooRole' );
+ok( $foobar_class_meta->does_role('BarRole'),
+    '... the FooBarClass->meta does_role BarRole' );
+ok( !$foobar_class_meta->does_role('OtherRole'),
+    '... the FooBarClass->meta !does_role OtherRole' );
 
 foreach my $method_name (qw(bar baz foo boo blau goo)) {
-    ok($foo_class_meta->has_method($method_name), '... FooClass has the method ' . $method_name);    
-    ok($foobar_class_meta->has_method($method_name), '... FooBarClass has the method ' . $method_name);
+    ok( $foo_class_meta->has_method($method_name),
+        '... FooClass has the method ' . $method_name );
+    ok( $foobar_class_meta->has_method($method_name),
+        '... FooBarClass has the method ' . $method_name );
 }
 
-ok(!$foo_class_meta->has_method('woot'), '... FooClass lacks the method woot');    
-ok($foobar_class_meta->has_method('woot'), '... FooBarClass has the method woot');
+ok( !$foo_class_meta->has_method('woot'),
+    '... FooClass lacks the method woot' );
+ok( $foobar_class_meta->has_method('woot'),
+    '... FooBarClass has the method woot' );
 
 foreach my $attr_name (qw(bar baz)) {
-    ok($foo_class_meta->has_attribute($attr_name), '... FooClass has the attribute ' . $attr_name);    
-    ok($foobar_class_meta->has_attribute($attr_name), '... FooBarClass has the attribute ' . $attr_name);    
+    ok( $foo_class_meta->has_attribute($attr_name),
+        '... FooClass has the attribute ' . $attr_name );
+    ok( $foobar_class_meta->has_attribute($attr_name),
+        '... FooBarClass has the attribute ' . $attr_name );
 }
 
-can_ok('FooClass', 'does');
-ok(FooClass->does('FooRole'), '... the FooClass does FooRole');
-ok(!FooClass->does('BarRole'), '... the FooClass does not do BarRole');
-ok(!FooClass->does('OtherRole'), '... the FooClass does not do OtherRole');
+can_ok( 'FooClass', 'does' );
+ok( FooClass->does('FooRole'),    '... the FooClass does FooRole' );
+ok( !FooClass->does('BarRole'),   '... the FooClass does not do BarRole' );
+ok( !FooClass->does('OtherRole'), '... the FooClass does not do OtherRole' );
 
-can_ok('FooBarClass', 'does');
-ok(FooBarClass->does('FooRole'), '... the FooClass does FooRole');
-ok(FooBarClass->does('BarRole'), '... the FooBarClass does FooBarRole');
-ok(!FooBarClass->does('OtherRole'), '... the FooBarClass does not do OtherRole');
+can_ok( 'FooBarClass', 'does' );
+ok( FooBarClass->does('FooRole'), '... the FooClass does FooRole' );
+ok( FooBarClass->does('BarRole'), '... the FooBarClass does FooBarRole' );
+ok( !FooBarClass->does('OtherRole'),
+    '... the FooBarClass does not do OtherRole' );
 
 my $foo = FooClass->new();
-isa_ok($foo, 'FooClass');
+isa_ok( $foo, 'FooClass' );
 
 my $foobar = FooBarClass->new();
-isa_ok($foobar, 'FooBarClass');
-
-is($foo->goo, 'FooClass::goo', '... got the right value of goo');
-is($foobar->goo, 'FooRole::goo', '... got the right value of goo');    
-
-is($foo->boo, 'FooRole::boo -> BarClass::boo', '... got the right value from ->boo');
-is($foobar->boo, 'FooRole::boo -> FooRole::boo -> BarClass::boo', '... got the right value from ->boo (double wrapped)');    
-
-is($foo->blau, 'FooRole::blau -> FooClass::blau', '... got the right value from ->blau');
-is($foobar->blau, 'FooRole::blau -> FooRole::blau -> FooClass::blau', '... got the right value from ->blau');
-
-foreach my $foo ($foo, $foobar) {
-    can_ok($foo, 'does');
-    ok($foo->does('FooRole'), '... an instance of FooClass does FooRole');
-    ok(!$foo->does('OtherRole'), '... and instance of FooClass does not do OtherRole');
-
-    can_ok($foobar, 'does');
-    ok($foobar->does('FooRole'), '... an instance of FooBarClass does FooRole');
-    ok($foobar->does('BarRole'), '... an instance of FooBarClass does BarRole');
-    ok(!$foobar->does('OtherRole'), '... and instance of FooBarClass does not do OtherRole');
+isa_ok( $foobar, 'FooBarClass' );
+
+is( $foo->goo,    'FooClass::goo', '... got the right value of goo' );
+is( $foobar->goo, 'FooRole::goo',  '... got the right value of goo' );
+
+is( $foo->boo, 'FooRole::boo -> BarClass::boo',
+    '... got the right value from ->boo' );
+is( $foobar->boo, 'FooRole::boo -> FooRole::boo -> BarClass::boo',
+    '... got the right value from ->boo (double wrapped)' );
+
+is( $foo->blau, 'FooRole::blau -> FooClass::blau',
+    '... got the right value from ->blau' );
+is( $foobar->blau, 'FooRole::blau -> FooRole::blau -> FooClass::blau',
+    '... got the right value from ->blau' );
+
+foreach my $foo ( $foo, $foobar ) {
+    can_ok( $foo, 'does' );
+    ok( $foo->does('FooRole'), '... an instance of FooClass does FooRole' );
+    ok( !$foo->does('OtherRole'),
+        '... and instance of FooClass does not do OtherRole' );
+
+    can_ok( $foobar, 'does' );
+    ok( $foobar->does('FooRole'),
+        '... an instance of FooBarClass does FooRole' );
+    ok( $foobar->does('BarRole'),
+        '... an instance of FooBarClass does BarRole' );
+    ok( !$foobar->does('OtherRole'),
+        '... and instance of FooBarClass does not do OtherRole' );
 
     for my $method (qw/bar baz foo boo goo blau/) {
-        can_ok($foo, $method);
+        can_ok( $foo, $method );
     }
 
-    is($foo->foo, 'FooRole::foo', '... got the right value of foo');
+    is( $foo->foo, 'FooRole::foo', '... got the right value of foo' );
 
-    ok(!defined($foo->baz), '... $foo->baz is undefined');
-    ok(!defined($foo->bar), '... $foo->bar is undefined');
+    ok( !defined( $foo->baz ), '... $foo->baz is undefined' );
+    ok( !defined( $foo->bar ), '... $foo->bar is undefined' );
 
-    dies_ok {
-        $foo->baz(1)
-    } '... baz is a read-only accessor';
+    ok exception {
+        $foo->baz(1);
+    },
+    '... baz is a read-only accessor';
 
-    dies_ok {
-        $foo->bar(1)
-    } '... bar is a read-write accessor with a type constraint';
+    ok exception {
+        $foo->bar(1);
+    },
+    '... bar is a read-write accessor with a type constraint';
 
     my $foo2 = FooClass->new();
-    isa_ok($foo2, 'FooClass');
+    isa_ok( $foo2, 'FooClass' );
 
-    lives_ok {
-        $foo->bar($foo2)
-    } '... bar is a read-write accessor with a type constraint';
+    ok ! exception {
+        $foo->bar($foo2);
+    },
+    '... bar is a read-write accessor with a type constraint';
 
-    is($foo->bar, $foo2, '... got the right value for bar now');
+    is( $foo->bar, $foo2, '... got the right value for bar now' );
 }
+
+done_testing;