view _test/Test/Object/Fields.pm @ 375:441e84031c7b

docs
author cin
date Fri, 10 Jan 2014 16:33:00 +0400
parents 4d0e1962161c
children
line wrap: on
line source

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

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

__PACKAGE__->PassThroughArgs;

{
    package Fields::Foo;
    use base qw(IMPL::Object::Fields);
    
    use fields qw(name info);
    
    sub CTOR {
        my ($this,$name,$info) = @_;
        
        $this->{name} = $name;
        $this->{info} = $info;
    }
    
    package Fields::Bar;
    use base qw(Fields::Foo);
    use fields qw(id);
    
    our %CTOR = (
        'Fields::Foo' => sub {
            my %args = @_;
            Bar => $args{info};
        }
    );
    
    sub CTOR {
        my ($this,%args) = @_;
        
        $this->{id} = $args{id};
    }
}

test constructObject => sub {
    my $obj = new Fields::Foo( Peter => '34-fg-78' );
    
    $obj->{name} eq 'Peter' or failed "A value of 'name' field is wrong","Expected: 'Peter'","Got: '$obj->{name}'";
};

test inheritance => sub {
    my $obj = new Fields::Bar( id => '1ba356f', info => 'standard bar');
    
    $obj->{name} eq 'Bar' or failed "A value of 'name' property is wrong","Expected: 'Bar'","Got: '$obj->{name}'";
    $obj->{id} eq '1ba356f' or failed "A value of 'id' property is wrong","Expected: '1ba356f'","Got: '$obj->{id}'";
};

1;