convert all uses of Test::Exception to Test::Fatal.

[gitmo/Moose.git] / t / 020_attributes / 010_attribute_delegation.t

diff --git a/t/020_attributes/010_attribute_delegation.t b/t/020_attributes/010_attribute_delegation.t
index 45505a1..c2f50b9 100644 (file)
--- a/t/020_attributes/010_attribute_delegation.t
+++ b/t/020_attributes/010_attribute_delegation.t
@@ -3,9 +3,8 @@
 use strict;
 use warnings;
 
-use Test::More tests => 88;
-use Test::Exception;
-
+use Test::More;
+use Test::Fatal;
 
 
 # -------------------------------------------------------------------
@@ -21,13 +20,19 @@ use Test::Exception;
 
     has 'bar' => (is => 'rw', default => 10);
 
+    sub baz { 42 }
+
     package Bar;
     use Moose;
 
     has 'foo' => (
         is      => 'rw',
         default => sub { Foo->new },
-        handles => { 'foo_bar' => 'bar' }
+        handles => {
+            'foo_bar' => 'bar',
+            foo_baz => 'baz',
+            'foo_bar_to_20' => [ bar => 20 ],
+        },
     );
 }
 
@@ -72,15 +77,19 @@ isa_ok($foo, 'Foo');
 
 is($foo->bar, 25, '... got the right foo->bar');
 
-lives_ok {
+ok ! exception {
     $bar->foo($foo);
-} '... assigned the new Foo to Bar->foo';
+}, '... assigned the new Foo to Bar->foo';
 
 is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
 
 is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
 is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
 
+# curried handles
+$bar->foo_bar_to_20;
+is($bar->foo_bar, 20, '... correctly curried a single argument');
+
 # -------------------------------------------------------------------
 # ARRAY handles
 # -------------------------------------------------------------------
@@ -234,6 +243,15 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
         handles => 'Foo::Bar',
     );
 
+    package Foo::OtherThing;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    has 'other_thing' => (
+        is      => 'rw',
+        isa     => 'Foo::Baz',
+        handles => Moose::Util::TypeConstraints::find_type_constraint('Foo::Bar'),
+    );
 }
 
 {
@@ -250,6 +268,19 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');
 }
 
+{
+    my $foo = Foo::OtherThing->new(other_thing => Foo::Baz->new);
+    isa_ok($foo, 'Foo::OtherThing');
+    isa_ok($foo->other_thing, 'Foo::Baz');
+
+    ok($foo->meta->has_method('foo'), '... we have the method we expect');
+    ok($foo->meta->has_method('bar'), '... we have the method we expect');
+    ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');
+
+    is($foo->foo, 'Foo::Baz::FOO', '... got the right value');
+    is($foo->bar, 'Foo::Baz::BAR', '... got the right value');
+    is($foo->other_thing->baz, 'Foo::Baz::BAZ', '... got the right value');
+}
 # -------------------------------------------------------------------
 # AUTOLOAD & handles
 # -------------------------------------------------------------------
@@ -262,7 +293,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
         my $self = shift;
 
         my $name = our $AUTOLOAD;
-        $name =~ s/.*://;              # strip fully-qualified portion
+        $name =~ s/.*://; # strip fully-qualified portion
 
         if (@_) {
             return $self->{$name} = shift;
@@ -292,13 +323,13 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     package Goorch::Autoloaded;
     use Moose;
 
-    ::dies_ok {
+    ::ok ::exception {
         has 'foo' => (
             is      => 'rw',
             default => sub { Foo::Autoloaded->new },
             handles => qr/bar/
         );
-    } '... you cannot delegate to AUTOLOADED class with regexp';
+    }, '... you cannot delegate to AUTOLOADED class with regexp';
 }
 
 # check HASH based delegation w/ AUTOLOAD
@@ -337,9 +368,9 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
     is($foo->bar, 25, '... got the right foo->bar');
 
-    lives_ok {
+    ok ! exception {
         $bar->foo($foo);
-    } '... assigned the new Foo to Bar->foo';
+    }, '... assigned the new Foo to Bar->foo';
 
     is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
 
@@ -383,9 +414,9 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
     is($foo->bar, 25, '... got the right foo->bar');
 
-    lives_ok {
+    ok ! exception {
         $baz->foo($foo);
-    } '... assigned the new Foo to Baz->foo';
+    }, '... assigned the new Foo to Baz->foo';
 
     is($baz->foo, $foo, '... assigned baz->foo with the new Foo');
 
@@ -410,3 +441,19 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     ok(!$i->meta->has_method('foo_bar'), 'handles method foo_bar is removed');
 }
 
+# Make sure that a useful error message is thrown when the delegation target is
+# not an object
+{
+    my $i = Bar->new(foo => undef);
+    like exception { $i->foo_bar }, qr/is not defined/,
+        'useful error from unblessed reference';
+
+    my $j = Bar->new(foo => []);
+    like exception { $j->foo_bar }, qr/is not an object \(got 'ARRAY/,
+        'useful error from unblessed reference';
+
+    my $k = Bar->new(foo => "Foo");
+    ok ! exception { $k->foo_baz }, "but not for class name";
+}
+
+done_testing;