[libbread-board-perl] 50/66: Implement container inheritance

[Jonas Smedegaard]

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 64d884c40ea0ef772b526e41b934a06b371f9f71
Author: Florian Ragwitz <rafl at debian.org>
Date:   Wed Aug 28 13:50:03 2013 -0400

    Implement container inheritance
---
 lib/Bread/Board.pm                  |   11 +++++-
 t/153_sugar_container_inheritance.t |   71 +++++++++++++++++++++++++++++++++++
 2 files changed, 81 insertions(+), 1 deletion(-)

diff --git a/lib/Bread/Board.pm b/lib/Bread/Board.pm
index 16c97c9..6a28f05 100644
--- a/lib/Bread/Board.pm
+++ b/lib/Bread/Board.pm
@@ -53,6 +53,10 @@ sub container ($;$$) {
         $name_is_obj = 1;
     }
 
+    my $is_inheriting = !$name_is_obj && $name =~ s/^\+//;
+    confess "Inheriting containers isn't possible outside of the context of a container"
+        if $is_inheriting && !defined $CC;
+
     my $c;
     if ($name_is_obj) {
         confess 'container($object, ...) is not supported for parameterized containers'
@@ -66,6 +70,9 @@ sub container ($;$$) {
         # if we have more than 1 argument, then we are a parameterized
         # container, so we need to act accordingly
         if (scalar @_ > 1) {
+            confess 'Declaring container parameters when inheriting is not supported'
+                if $is_inheriting;
+
             my $param_names = shift;
             $c = Bread::Board::Container::Parameterized->new({
                 name                    => $name,
@@ -73,7 +80,9 @@ sub container ($;$$) {
             });
         }
         else {
-            $c = Bread::Board::Container->new({ name => $name });
+            $c = $is_inheriting
+                ? $CC->fetch($name)
+                : Bread::Board::Container->new({ name => $name });
         }
     }
 
diff --git a/t/153_sugar_container_inheritance.t b/t/153_sugar_container_inheritance.t
new file mode 100644
index 0000000..d9c07d3
--- /dev/null
+++ b/t/153_sugar_container_inheritance.t
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+use Bread::Board;
+
+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 $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'),
+            },
+        );
+    };
+};
+
+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;
+
+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 {};
+    };
+}, 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/;
+
+done_testing;

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