view _test/Test/Object/Fields.pm @ 181:47dac58691ee

New templating system, small fixes
author sourcer
date Thu, 26 Jan 2012 01:15:57 +0400
parents d1676be8afcc
children 4d0e1962161c
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;