comparison _test/Test/Config/Container.pm @ 422:b0481c071bea ref20150831

IMPL::Config::Container tests, YAMLConfiguration now works and tested
author cin
date Sun, 20 Aug 2017 00:20:41 +0300
parents 3f38dabaf5cc
children
comparison
equal deleted inserted replaced
421:7798345304bc 422:b0481c071bea
1 package Test::Config::Container; 1 package Test::Config::Container;
2 use strict; 2 use strict;
3 3
4 sub true() { 1 }
5 sub false() { 0 }
6
4 { 7 {
8
5 package Test::Config::Container::Baz; 9 package Test::Config::Container::Baz;
6 use IMPL::declare { 10 use IMPL::declare {
7 base => { 11 base => {
8 'IMPL::Object' => undef 12 'IMPL::Object' => undef
9 }, 13 },
10 props => [ 14 props => [
11 value => 'r' 15 value => 'r'
12 ] 16 ]
13 }; 17 };
14 18
15 sub CTOR { 19 sub CTOR {
16 my $this = shift; 20 my $this = shift;
17 $this->value(shift); 21 $this->value(shift);
18 } 22 }
19 } 23 }
20 24
21 use IMPL::declare { 25 use IMPL::declare {
22 require => { 26 require => {
23 Container => 'IMPL::Config::Container', 27 Container => 'IMPL::Config::Container',
24 28 Service => 'IMPL::Config::ServiceDescriptor',
25 }, 29 Value => 'IMPL::Config::ValueDescriptor',
26 base => { 30 Reference => 'IMPL::Config::ReferenceDescriptor',
27 'IMPL::Test::Unit' => '@_' 31 YAMLConfig => 'IMPL::Config::YAMLConfig'
28 } 32 },
33 base => {
34 'IMPL::Test::Unit' => '@_'
35 }
29 }; 36 };
37 use File::Spec();
30 use IMPL::Test qw(test assert failed); 38 use IMPL::Test qw(test assert failed);
39 use IMPL::lang qw(:base);
31 40
32 test CreateContainer => sub { 41 test CreateContainer => sub {
33 my $c1 = Container->new(); 42 my $c1 = Container->new();
34 }; 43 $c1->Dispose();
35
36 test RegisterServices => sub {
37 my $c1 = Container->new();
38
39 $c1->Register( 'db' => Service->new(
40 type => 'Foo::Data',
41 norequire => 1,
42 activation => 'container'
43 ));
44
45 return $c1;
46 };
47
48 test ResolveServices => sub {
49
50 }; 44 };
51 45
52 46
47
48 sub RegisterServices {
49 my $c1 = Container->new();
50
51 my %config = (
52 'db' => Service->new(
53 type => 'Foo::Data',
54 norequire => 1,
55 activation => 'container'
56 ),
57 foo => Service->new(
58 type => 'Test::Config::Foo',
59 activation => 'container'
60 ),
61 bar => Service->new(
62 type => 'Test::Config::Bar',
63 activation => 'context'
64 ),
65 boogie => Value->new(
66 {
67 foo => Reference->new('foo'),
68 bar => Reference->new('bar'),
69 lazyb => Reference->new( 'bar', lazy => 1 ),
70 opt => Reference->new(
71 'no-such-ref',
72 optional => 1,
73 default => 'def-opt'
74 )
75 }
76 )
77 );
78
79 while(my ($name, $d) = each %config) {
80 $c1->Register($name, $d);
81 }
82
83 return $c1->AutoPtr();
84 };
85
86 test RegisterServices => \&RegisterServices;
87
88 test ResolveServices => sub {
89 my $this = shift;
90 my $c = $this->RegisterServices();
91
92 my $foo = $c->Resolve('foo');
93 assert(is($foo, "Test::Config::Foo"), "foo is: $foo");
94
95 my $foo2 = $c->Resolve('foo');
96 assert($foo == $foo2);
97
98 my $bar = $c->Resolve('bar');
99 assert(is($bar, "Test::Config::Bar"));
100
101 my $bar2 = $c->Resolve('bar');
102
103 assert($bar != $bar2);
104
105 my $boogie = $c->Resolve('boogie');
106 assert(ishash($boogie));
107 assert(is($boogie->{foo}, "Test::Config::Foo"));
108
109 $bar = $boogie->{bar};
110 my $lazyb = $boogie->{lazyb};
111 assert(ref $lazyb eq 'CODE');
112 $bar2 = $lazyb->();
113 my $bar3 = $lazyb->();
114
115 #test context activation with lazy
116 assert($bar == $bar2);
117 assert($bar == $bar3);
118
119 my $bar4 = $c->Resolve('bar');
120 #new context, new bar
121 assert($bar != $bar4);
122
123 my $opt = $boogie->{opt};
124 assert($opt eq 'def-opt');
125 };
126
127 sub LoadYamlConfig {
128 my $config = YAMLConfig->new();
129 $config->Load(File::Spec->catfile('Resources', 'container1.yaml'));
130 my $container = Container->new();
131 $config->ConfigureContainer($container);
132 return $container->AutoPtr();
133 }
134
135 test LoadYamlConfig => \&LoadYamlConfig;
136 test ResolveYamlConfig => sub {
137 my $this = shift;
138
139 my $c = $this->LoadYamlConfig();
140
141 my $foo = $c->Resolve('foo');
142 assert(is($foo, "Test::Config::Foo"), "foo is: $foo");
143
144 my $foo2 = $c->Resolve('foo');
145 assert($foo == $foo2);
146
147 my $bar = $c->Resolve('bar');
148 assert(is($bar, "Test::Config::Bar"));
149
150 my $bar2 = $c->Resolve('bar');
151
152 assert($bar != $bar2);
153
154 my $baz = $c->Resolve('baz');
155 assert(is($baz, "Test::Config::Foo"));
156 assert(isarray($baz->value));
157 assert($baz->value->[0] == $baz->value->[1]);
158 };
159
53 1; 160 1;