view _test/Test/Object/Common.pm @ 263:0f59b2de72af

*fixed IMPL::DOM::Schema circular module references *modified IMPL::Object::Singleton, added auto-activation *code cleanups, docs
author sergey
date Wed, 09 Jan 2013 05:17:44 +0400
parents 76515373dac0
children ced5937ff21a
line wrap: on
line source

package Test::Object::Common;
use strict;
use warnings;

use parent qw( IMPL::Test::Unit );
use IMPL::Test qw(test failed cmparray);

__PACKAGE__->PassThroughArgs;

{
    package Foo;
    use parent qw(IMPL::Object);
    
    sub CTOR {
        my ($this,$refarg) = @_;
        $$refarg = 1;
    }
    
    package Bar;
    use parent qw(-norequire Foo);
    
    __PACKAGE__->PassThroughArgs;
    
    sub CTOR {
        my ($this,$ref,$array) = @_;
        
        push @$array,__PACKAGE__;
    }
    
    package Baz;
    use parent qw(-norequire Bar);
    
    our %CTOR = (
        Bar => sub {
            my $t;
            (\$t,$_[0]);
        }
    );
    
    sub CTOR {
        my ($this,$array) = @_;
        push @$array,__PACKAGE__;
    }
    
    package Zoo;
    use parent qw(-norequire Bar);
    
    __PACKAGE__->PassThroughArgs;
    
    sub CTOR {
       my ($this,$ref,$array) = @_;
       
       push @$array,__PACKAGE__;
    };
    
    package Complex;
    use parent qw(-norequire Baz Zoo);
    
    our %CTOR = (
        Baz => sub { @_ },
        Zoo => sub {
            my $t;
            (\$t,$_[0]);
        }
    );
    
}

test Creation => sub {
    my $flag = 0;
    
    my $obj = new Foo(\$flag);
    
    die new IMPL::Test::FailException("Object is undef") unless $obj;
    die new IMPL::Test::FailException("Contructor doesn't run") unless $obj;
};

test SimpleInheritance => sub {
    my $sequence = [];
    my $flag = 0;
    my $obj = new Bar(\$flag,$sequence);
    
    failed "Object is undef" unless $obj;
    failed "Base class constructor isn't called" unless $flag;
    failed "Class constructor isn't called" unless @$sequence;
};

test SimpleInheritance2 => sub {
    my $sequence = [];
    my $expected = [qw(Bar Baz)];
    my $obj = new Baz($sequence);
    
    failed "Object is undef" unless $obj;
    failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected;
};

test MultipleInheritance => sub {
    my $sequence = [];
    my $expected = [qw(Bar Baz Bar Zoo)];
    my $obj = new Complex($sequence);
    
    failed "Object is undef" unless $obj;
    failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected;
};

1;