Mercurial > pub > Impl

annotate _test/Test/Config/Container.pm @ 423:60c2892a577c ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
working on base class system
author cin
date Mon, 02 Apr 2018 07:35:23 +0300
parents b0481c071bea
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;