CPAN::Groonga

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 67;

BEGIN {
    use_ok('IOC::Proxy');
}

# NOTE:
# this tests that we are successful 
# even with the case of multiple 
# (diamond) inheritance.
#
#          Base
#          /  \
#  Base::One  Base::Two
#         \   / 
#       Base::Three
#           |
#           V
#   Base::Three::_::Proxy

{ 
    package Base;
    
    sub new  { bless {}, ref($_[0]) || $_[0] }
    sub base { return (caller(1))[3] }
    
    package Base::One;
    our @ISA = 'Base';
    
    sub test { return "... I am Base::One::test" }
    sub base_one { return "... I am Base::One::base_one" }
    sub base_one_test { return "... I am Base::One::base_one_test" }
    
    package Base::Two;
    our @ISA = 'Base';

    sub test { return "... I am Base::Two::test" }
    sub base_two { return "... I am Base::Two::base_two" }
    sub base_two_test { return "... I am Base::Two::base_two_test" }
    
    package Base::Three;
    our @ISA = ('Base::One', 'Base::Two');
    
    sub new  { bless {}, ref($_[0]) || $_[0] }
    sub base_three_test { (shift)->base() }
}

my $obj_to_proxy = Base::Three->new();
isa_ok($obj_to_proxy, 'Base::Three');

my (@method_call, @wrap);

my $proxy_server = IOC::Proxy->new({ 
                            on_method_call => sub {
                                push @method_call, \@_;
                                },
                            on_wrap => sub {
                                push @wrap, \@_;                                
                                }
                            });
isa_ok($proxy_server, 'IOC::Proxy');

my $proxy = $proxy_server->wrap($obj_to_proxy);
isa_ok($proxy, 'Base::Three::_::Proxy');
isa_ok($proxy, 'Base::Three');
isa_ok($proxy, 'Base::Two');
isa_ok($proxy, 'Base::One');
isa_ok($proxy, 'Base');

is(overload::StrVal($obj_to_proxy), overload::StrVal($proxy), '... these are the same instances deep down');
isa_ok($obj_to_proxy, 'Base::Three::_::Proxy');

is_deeply(\@wrap, [ [ $proxy_server, $obj_to_proxy, 'Base::Three::_::Proxy' ] ], '... got what we expected');

ok(UNIVERSAL::isa($proxy, 'Base::Three'), '... our proxy is a Base::Three');
ok(UNIVERSAL::isa($proxy, 'Base::Two'), '... our proxy is a Base::Two');
ok(UNIVERSAL::isa($proxy, 'Base::One'), '... our proxy is a Base::One');
ok(UNIVERSAL::isa($proxy, 'Base'), '... our proxy is a Base');

can_ok($proxy, 'new');
can_ok($proxy, 'base_two_test');
can_ok($proxy, 'base_two');
can_ok($proxy, 'test');
can_ok($proxy, 'base_one_test');
can_ok($proxy, 'base_one');
can_ok($proxy, 'base');

ok(UNIVERSAL::can($proxy, 'new'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy, 'base_two_test'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy, 'base_two'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy, 'test'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy, 'base_one_test'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy, 'base_one'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy, 'base'), '... our proxy responded correctly to "can"');

is_deeply(\@method_call, [], '... nothing, as we expected');

is($proxy->base_two_test(1, 2, 3), '... I am Base::Two::base_two_test', '... got what we expected');
is($proxy->base_two(4, 5, 6), '... I am Base::Two::base_two', '... got what we expected');
is($proxy->test(7, 8, 9), '... I am Base::One::test', '... got what we expected');
is($proxy->base_one_test(10, 11, 12), '... I am Base::One::base_one_test', '... got what we expected');
is($proxy->base_one(13, 14, 15), '... I am Base::One::base_one', '... got what we expected');
is($proxy->base_three_test(16, 17, 18), 'Base::Three::base_three_test', '... got the caller info we expected');

is_deeply(\@method_call, [
         [ $proxy_server, 'base_two_test', 'Base::Two::base_two_test', [ $proxy, 1, 2, 3 ] ],
         [ $proxy_server, 'base_two', 'Base::Two::base_two', [ $proxy, 4, 5, 6 ] ],
         [ $proxy_server, 'test', 'Base::One::test', [ $proxy, 7, 8, 9 ] ],
         [ $proxy_server, 'base_one_test', 'Base::One::base_one_test', [ $proxy, 10, 11, 12 ] ],
         [ $proxy_server, 'base_one', 'Base::One::base_one', [ $proxy, 13, 14, 15 ] ],
         [ $proxy_server, 'base_three_test', 'Base::Three::base_three_test', [ $proxy, 16, 17, 18 ] ],
         # and dont forget the internal call as well
         [ $proxy_server, 'base', 'Base::base', [ $proxy ] ]                
         ], '... got all that we expected');

# and now create a new proxy object 
# from our original one and make sure
# it too can do all that the original 
# can do.

my $proxy2 = $proxy->new();

isnt($proxy, $proxy2, '... they are not the same instance');

isa_ok($proxy2, 'Base::Three::_::Proxy');
isa_ok($proxy2, 'Base::Three');
isa_ok($proxy2, 'Base::Two');
isa_ok($proxy2, 'Base::One');
isa_ok($proxy2, 'Base');

ok(UNIVERSAL::isa($proxy2, 'Base::Three'), '... our proxy is a Base::Three');
ok(UNIVERSAL::isa($proxy2, 'Base::Two'), '... our proxy is a Base::Two');
ok(UNIVERSAL::isa($proxy2, 'Base::One'), '... our proxy is a Base::One');
ok(UNIVERSAL::isa($proxy2, 'Base'), '... our proxy is a Base');

can_ok($proxy2, 'new');
can_ok($proxy2, 'base_two_test');
can_ok($proxy2, 'base_two');
can_ok($proxy2, 'test');
can_ok($proxy2, 'base_one_test');
can_ok($proxy2, 'base_one');
can_ok($proxy2, 'base');

is($proxy2->base_two_test(), '... I am Base::Two::base_two_test', '... got what we expected');
is($proxy2->base_two(), '... I am Base::Two::base_two', '... got what we expected');
is($proxy2->test(), '... I am Base::One::test', '... got what we expected');
is($proxy2->base_one_test(), '... I am Base::One::base_one_test', '... got what we expected');
is($proxy2->base_one(), '... I am Base::One::base_one', '... got what we expected');
is($proxy2->base_three_test(), 'Base::Three::base_three_test', '... got the caller info we expected');

ok(UNIVERSAL::can($proxy2, 'new'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy2, 'base_two_test'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy2, 'base_two'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy2, 'test'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy2, 'base_one_test'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy2, 'base_one'), '... our proxy responded correctly to "can"');
ok(UNIVERSAL::can($proxy2, 'base'), '... our proxy responded correctly to "can"');