[libbread-board-perl] 53/66: Test subcontainer inheritance

Jonas Smedegaard js at alioth.debian.org
Sun Sep 29 21:23:39 UTC 2013


This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libbread-board-perl.

commit d92c7c4ab3a285d55697da562586eb6a5302dd86
Author: Florian Ragwitz <rafl at debian.org>
Date:   Wed Aug 28 14:15:30 2013 -0400

    Test subcontainer inheritance
---
 t/153_sugar_container_inheritance.t |  137 +++++++++++++++++++++++------------
 1 file changed, 91 insertions(+), 46 deletions(-)

diff --git a/t/153_sugar_container_inheritance.t b/t/153_sugar_container_inheritance.t
index d9c07d3..8c5234e 100644
--- a/t/153_sugar_container_inheritance.t
+++ b/t/153_sugar_container_inheritance.t
@@ -8,64 +8,109 @@ use Test::Fatal;
 
 use Bread::Board;
 
-my $c = container Foo => as {
-    container Bar => as {
-        service baz => 21;
-    };
+{
+    my $c = container Foo => as {
+        container Bar => as {
+            service baz => 21;
+        };
 
-    container Moo => ['Bar'] => as {
-        service kooh => (
-            block => sub {
-                my ($s) = @_;
-                $s->param('baz') * 2;
-            },
-            dependencies => {
-                baz => depends_on('Bar/baz'),
-            },
-        );
+        container Moo => ['Bar'] => as {
+            service kooh => (
+                block => sub {
+                    my ($s) = @_;
+                    $s->param('baz') * 2;
+                },
+                dependencies => {
+                    baz => depends_on('Bar/baz'),
+                },
+            );
+        };
     };
-};
 
-container $c => as {
-    container '+Bar' => as {
-        service bif => 123;
-    };
+    container $c => as {
+        container '+Bar' => as {
+            service bif => 123;
+        };
 
-    container '+Moo' => as {
-        service boo => (
-            block => sub {
-                my ($s) = @_;
-                $s->param('a') + $s->param('b');
-            },
-            dependencies => {
-                a => depends_on('kooh'),
-                b => depends_on('Bar/bif'),
-            },
-        );
+        container '+Moo' => as {
+            service boo => (
+                block => sub {
+                    my ($s) = @_;
+                    $s->param('a') + $s->param('b');
+                },
+                dependencies => {
+                    a => depends_on('kooh'),
+                    b => depends_on('Bar/bif'),
+                },
+            );
+        };
     };
-};
 
-is $c->resolve(service => 'Bar/baz'), 21;
-is $c->resolve(service => 'Bar/bif'), 123;
+    is $c->resolve(service => 'Bar/baz'), 21;
+    is $c->resolve(service => 'Bar/bif'), 123;
 
-my $p = $c->fetch('Moo')->create(Bar => $c->fetch('Bar'));
-is $p->resolve(service => 'kooh'), 42;
-is $p->resolve(service => 'boo'), 165;
+    my $p = $c->fetch('Moo')->create(Bar => $c->fetch('Bar'));
+    is $p->resolve(service => 'kooh'), 42;
+    is $p->resolve(service => 'boo'), 165;
 
-like exception {
-    container '+Foo' => as {};
-}, qr/^Inheriting containers isn't possible outside of the context of a container/;
+    like exception {
+        container '+Foo' => as {};
+    }, qr/^Inheriting containers isn't possible outside of the context of a container/;
 
-like exception {
-    container $c => as {
-        container '+Buf' => as {};
+    like exception {
+        container $c => as {
+            container '+Buf' => as {};
+        };
+    }, qr/^Could not find container or service for Buf in Foo/;
+
+    like exception {
+        container $c => as {
+            container '+Buf' => ['Moo'] => as {};
+        };
+    }, qr/^Declaring container parameters when inheriting is not supported/;
+}
+
+{
+    {
+        package Thing;
+        use Moose;
+        has bar => (is => 'ro', required => 1);
+        no Moose;
+    }
+
+    {
+        package TestThing;
+        use Moose;
+        extends 'Thing';
+        no Moose;
+    }
+
+    my $c = container Foo => as {
+        service bar => 42;
+
+        container Moo => as {
+            container Kooh => as {
+                service boo => (
+                    class => 'Thing',
+                    dependencies => {
+                        bar => '../../bar',
+                    },
+                );
+            };
+        };
     };
-}, qr/^Could not find container or service for Buf in Foo/;
 
-like exception {
+    isa_ok $c->resolve(service => 'Moo/Kooh/boo'), 'Thing';
+    is $c->resolve(service => 'Moo/Kooh/boo')->bar, 42;
+
     container $c => as {
-        container '+Buf' => ['Moo'] => as {};
+        container '+Moo/Kooh' => as {
+            service '+boo' => (class => 'TestThing');
+        };
     };
-}, qr/^Declaring container parameters when inheriting is not supported/;
+
+    isa_ok $c->resolve(service => 'Moo/Kooh/boo'), 'TestThing';
+    is $c->resolve(service => 'Moo/Kooh/boo')->bar, 42;
+}
 
 done_testing;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libbread-board-perl.git



More information about the Pkg-perl-cvs-commits mailing list