[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