From 1a536f9127cd6c9b28000f6de00dfdbe21793224 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 16 Apr 2011 09:56:50 -0500
Subject: more tests

---
 t/50-infer.t | 172 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 168 insertions(+), 4 deletions(-)

diff --git a/t/50-infer.t b/t/50-infer.t
index d3bd1cc..88fcb68 100644
--- a/t/50-infer.t
+++ b/t/50-infer.t
@@ -2,6 +2,7 @@
 use strict;
 use warnings;
 use Test::More;
+use Test::Fatal;
 
 {
     package Foo;
@@ -36,6 +37,118 @@ use Test::More;
     use Bread::Board::Declare;
 
     has foo => (
+        is    => 'ro',
+        isa   => 'Foo',
+        block => sub { Foo->new },
+    );
+
+    has bar => (
+        is  => 'ro',
+        isa => 'Bar',
+    );
+
+    has baz => (
+        is  => 'ro',
+        isa => 'Baz',
+    );
+}
+
+{
+    my $c = My::Container->new;
+    isa_ok($c->baz, 'Baz');
+    isa_ok($c->baz->foo, 'Foo');
+    isa_ok($c->baz->bar, 'Bar');
+}
+
+{
+    package Baz2;
+    use Moose;
+
+    extends 'Baz';
+
+    has thing => (
+        is       => 'ro',
+        isa      => 'Str',
+        required => 1,
+    );
+}
+
+{
+    package My::Container2;
+    use Moose;
+    use Bread::Board::Declare;
+
+    has foo => (
+        is  => 'ro',
+        isa => 'Foo',
+    );
+
+    has bar => (
+        is  => 'ro',
+        isa => 'Bar',
+    );
+
+    has baz => (
+        is  => 'ro',
+        isa => 'Baz2',
+    );
+}
+
+{
+    like(
+        exception { My::Container2->new },
+        qr/^Only class types, role types, or subtypes of Object can be inferred\. I don't know what to do with type \(Str\)/,
+        "correct error when not everything can be inferred"
+    );
+}
+
+{
+    package My::Container3;
+    use Moose;
+    use Bread::Board::Declare;
+
+    has foo => (
+        is  => 'ro',
+        isa => 'Foo',
+    );
+
+    has bar => (
+        is  => 'ro',
+        isa => 'Bar',
+    );
+
+    has thing => (
+        is    => 'ro',
+        isa   => 'Str',
+        value => 'THING',
+    );
+
+    has baz => (
+        is           => 'ro',
+        isa          => 'Baz2',
+        dependencies => ['thing'],
+    );
+}
+
+{
+    my $c = My::Container3->new;
+    isa_ok($c->baz, 'Baz2');
+    isa_ok($c->baz->foo, 'Foo');
+    isa_ok($c->baz->bar, 'Bar');
+    is($c->baz->thing, 'THING', "partial dependency specification works");
+}
+
+{
+    package My::Container4;
+    use Moose;
+    use Bread::Board::Declare;
+
+    has foo => (
+        is  => 'ro',
+        isa => 'Foo',
+    );
+
+    has other_foo => (
         is  => 'ro',
         isa => 'Foo',
     );
@@ -51,9 +164,60 @@ use Test::More;
     );
 }
 
-my $c = My::Container->new;
-isa_ok($c->baz, 'Baz');
-isa_ok($c->baz->foo, 'Foo');
-isa_ok($c->baz->bar, 'Bar');
+{
+    like(
+        exception { My::Container4->new },
+        qr/^You have already declared a typemap for type Foo/,
+        "correct error when inferring is ambiguous"
+    );
+}
+
+{
+    package Foo2;
+    use Moose;
+
+    extends 'Foo';
+
+    has bar => (
+        is       => 'ro',
+        isa      => 'Bar',
+        required => 1,
+    );
+}
+
+{
+    package My::Container5;
+    use Moose;
+    use Bread::Board::Declare;
+
+    has foo => (
+        is  => 'ro',
+        isa => 'Foo2',
+    );
+
+    has other_foo => (
+        is      => 'ro',
+        isa     => 'Foo2',
+        typemap => 0,
+    );
+
+    has bar => (
+        is  => 'ro',
+        isa => 'Bar',
+    );
+
+    has baz => (
+        is  => 'ro',
+        isa => 'Baz',
+    );
+}
+
+{
+    my $c = My::Container5->new;
+    isa_ok($c->baz, 'Baz');
+    isa_ok($c->baz->foo, 'Foo');
+    isa_ok($c->baz->bar, 'Bar');
+    isa_ok($c->other_foo->bar, 'Bar');
+}
 
 done_testing;
-- 
cgit v1.2.3-54-g00ecf