view _test/Test/Object/Common.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 2e546a5175dd
children 16ada169ca75
line wrap: on
line source

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

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

__PACKAGE__->PassThroughArgs;

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