view _test/Test/Config/Container.pm @ 427:09e0086a82a7 ref20150831 tip

Merge
author cin
date Tue, 15 May 2018 00:51:33 +0300
parents b0481c071bea
children
line wrap: on
line source

package Test::Config::Container;
use strict;

sub true() { 1 }
sub false() { 0 }

{

    package Test::Config::Container::Baz;
    use IMPL::declare {
        base => {
            'IMPL::Object' => undef
        },
        props => [
            value => 'r'
        ]
    };

    sub CTOR {
        my $this = shift;
        $this->value(shift);
    }
}

use IMPL::declare {
    require => {
        Container => 'IMPL::Config::Container',
        Service   => 'IMPL::Config::ServiceDescriptor',
        Value     => 'IMPL::Config::ValueDescriptor',
        Reference => 'IMPL::Config::ReferenceDescriptor',
        YAMLConfig => 'IMPL::Config::YAMLConfig'
    },
    base => {
        'IMPL::Test::Unit' => '@_'
    }
};
use File::Spec();
use IMPL::Test qw(test assert failed);
use IMPL::lang qw(:base);

test CreateContainer => sub {
    my $c1 = Container->new();
    $c1->Dispose();
};



sub RegisterServices {
    my $c1 = Container->new();

    my %config = (
        'db' => Service->new(
            type       => 'Foo::Data',
            norequire  => 1,
            activation => 'container'
        ),
        foo => Service->new(
            type       => 'Test::Config::Foo',
            activation => 'container'
        ),
        bar => Service->new(
            type       => 'Test::Config::Bar',
            activation => 'context'
        ),
        boogie => Value->new(
            {
                foo   => Reference->new('foo'),
                bar   => Reference->new('bar'),
                lazyb => Reference->new( 'bar', lazy => 1 ),
                opt   => Reference->new(
                    'no-such-ref',
                    optional => 1,
                    default  => 'def-opt'
                )
            }
        )
    );
    
    while(my ($name, $d) = each %config) {
        $c1->Register($name, $d);
    }

    return $c1->AutoPtr();
};

test RegisterServices => \&RegisterServices;

test ResolveServices => sub {
    my $this = shift;
    my $c = $this->RegisterServices();
    
    my $foo = $c->Resolve('foo');
    assert(is($foo, "Test::Config::Foo"), "foo is: $foo");
    
    my $foo2 = $c->Resolve('foo');
    assert($foo == $foo2);
    
    my $bar = $c->Resolve('bar');
    assert(is($bar, "Test::Config::Bar"));
    
    my $bar2 = $c->Resolve('bar');
    
    assert($bar != $bar2);
    
    my $boogie = $c->Resolve('boogie');
    assert(ishash($boogie));
    assert(is($boogie->{foo}, "Test::Config::Foo"));
    
    $bar = $boogie->{bar};
    my $lazyb = $boogie->{lazyb};
    assert(ref $lazyb eq 'CODE');
    $bar2 = $lazyb->();
    my $bar3 = $lazyb->();
    
    #test context activation with lazy
    assert($bar == $bar2);
    assert($bar == $bar3);
    
    my $bar4 = $c->Resolve('bar');
    #new context, new bar
    assert($bar != $bar4);
    
    my $opt = $boogie->{opt};
    assert($opt eq 'def-opt');
};

sub LoadYamlConfig {
    my $config = YAMLConfig->new();
    $config->Load(File::Spec->catfile('Resources', 'container1.yaml'));
    my $container = Container->new();
    $config->ConfigureContainer($container);
    return $container->AutoPtr(); 
}

test LoadYamlConfig => \&LoadYamlConfig;
test ResolveYamlConfig => sub {
    my $this = shift;
    
    my $c = $this->LoadYamlConfig();
    
    my $foo = $c->Resolve('foo');
    assert(is($foo, "Test::Config::Foo"), "foo is: $foo");
    
    my $foo2 = $c->Resolve('foo');
    assert($foo == $foo2);
    
    my $bar = $c->Resolve('bar');
    assert(is($bar, "Test::Config::Bar"));
    
    my $bar2 = $c->Resolve('bar');
    
    assert($bar != $bar2);
    
    my $baz = $c->Resolve('baz');
    assert(is($baz, "Test::Config::Foo"));
    assert(isarray($baz->value));
    assert($baz->value->[0] == $baz->value->[1]);
};

1;