Mercurial > pub > Impl

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

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