Redid conversion to Test::Fatal

[gitmo/Moose.git] / t / 100_bugs / 006_handles_foreign_class_bug.t

diff --git a/t/100_bugs/006_handles_foreign_class_bug.t b/t/100_bugs/006_handles_foreign_class_bug.t
index 2554dd6..0a550fe 100644 (file)
--- a/t/100_bugs/006_handles_foreign_class_bug.t
+++ b/t/100_bugs/006_handles_foreign_class_bug.t
@@ -3,16 +3,16 @@
 use strict;
 use warnings;
 
-use Test::More tests => 8;
-use Test::Exception;
+use Test::More;
+use Test::Fatal;
 
 {
     package Foo;
 
-    sub new { 
-        bless({}, 'Foo') 
+    sub new {
+        bless({}, 'Foo')
     }
-    
+
     sub a { 'Foo::a' }
 }
 
@@ -20,7 +20,7 @@ use Test::Exception;
     package Bar;
     use Moose;
 
-    ::lives_ok {
+    ::is( ::exception {
         has 'baz' => (
             is      => 'ro',
             isa     => 'Foo',
@@ -28,23 +28,25 @@ use Test::Exception;
             default => sub { Foo->new() },
             handles => qr/^a$/,
         );
-    } '... can create the attribute with delegations';
-    
+    }, undef, '... can create the attribute with delegations' );
+
 }
 
 my $bar;
-lives_ok {
+is( exception {
     $bar = Bar->new;
-} '... created the object ok';
+}, undef, '... created the object ok' );
 isa_ok($bar, 'Bar');
 
 is($bar->a, 'Foo::a', '... got the right delgated value');
 
+my @w;
+$SIG{__WARN__} = sub { push @w, "@_" };
 {
     package Baz;
     use Moose;
 
-    ::lives_ok {
+    ::is( ::exception {
         has 'bar' => (
             is      => 'ro',
             isa     => 'Foo',
@@ -52,14 +54,17 @@ is($bar->a, 'Foo::a', '... got the right delgated value');
             default => sub { Foo->new() },
             handles => qr/.*/,
         );
-    } '... can create the attribute with delegations';
-    
+    }, undef, '... can create the attribute with delegations' );
+
 }
 
+is(@w, 0, "no warnings");
+
+
 my $baz;
-lives_ok {
+is( exception {
     $baz = Baz->new;
-} '... created the object ok';
+}, undef, '... created the object ok' );
 isa_ok($baz, 'Baz');
 
 is($baz->a, 'Foo::a', '... got the right delgated value');
@@ -68,6 +73,39 @@ is($baz->a, 'Foo::a', '... got the right delgated value');
 
 
 
+@w = ();
+
+{
+    package Blart;
+    use Moose;
+
+    ::is( ::exception {
+        has 'bar' => (
+            is      => 'ro',
+            isa     => 'Foo',
+            lazy    => 1,
+            default => sub { Foo->new() },
+            handles => [qw(a new)],
+        );
+    }, undef, '... can create the attribute with delegations' );
+
+}
+
+{
+    local $TODO = "warning not yet implemented";
+
+    is(@w, 1, "one warning");
+    like($w[0], qr/not delegating.*new/i, "warned");
+}
+
+
 
+my $blart;
+is( exception {
+    $blart = Blart->new;
+}, undef, '... created the object ok' );
+isa_ok($blart, 'Blart');
 
+is($blart->a, 'Foo::a', '... got the right delgated value');
 
+done_testing;