view _test/Test/Object/Fields.pm @ 164:eb3e9861a761

SQL traits in progress
author wizard
date Mon, 28 Mar 2011 01:36:24 +0400
parents
children d1676be8afcc
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;