Mercurial > pub > Impl
diff _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 diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/Test/Object/Fields.pm Mon Mar 28 01:36:24 2011 +0400 @@ -0,0 +1,54 @@ +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; \ No newline at end of file