view _test/Test/Object/Common.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +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;