Mercurial > pub > Impl
comparison _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 |
comparison
equal
deleted
inserted
replaced
| 163:6ce1f052b90a | 164:eb3e9861a761 |
|---|---|
| 1 package Test::Object::Fields; | |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 5 use base qw( IMPL::Test::Unit ); | |
| 6 use IMPL::Test qw(test failed cmparray); | |
| 7 | |
| 8 __PACKAGE__->PassThroughArgs; | |
| 9 | |
| 10 { | |
| 11 package Fields::Foo; | |
| 12 use base qw(IMPL::Object::Fields); | |
| 13 | |
| 14 use fields qw(name info); | |
| 15 | |
| 16 sub CTOR { | |
| 17 my ($this,$name,$info) = @_; | |
| 18 | |
| 19 $this->{name} = $name; | |
| 20 $this->{info} = $info; | |
| 21 } | |
| 22 | |
| 23 package Fields::Bar; | |
| 24 use base qw(Fields::Foo); | |
| 25 use fields qw(id); | |
| 26 | |
| 27 our %CTOR = ( | |
| 28 'Fields::Foo' => sub { | |
| 29 my %args = @_; | |
| 30 Bar => $args{info}; | |
| 31 } | |
| 32 ); | |
| 33 | |
| 34 sub CTOR { | |
| 35 my ($this,%args) = @_; | |
| 36 | |
| 37 $this->{id} = $args{id}; | |
| 38 } | |
| 39 } | |
| 40 | |
| 41 test constructObject => sub { | |
| 42 my $obj = new Fields::Foo( Peter => '34-fg-78' ); | |
| 43 | |
| 44 $obj->{name} eq 'Peter' or failed "A value of 'name' field is wrong","Expected: 'Peter'","Got: '$obj->{name}'"; | |
| 45 }; | |
| 46 | |
| 47 test inheritance => sub { | |
| 48 my $obj = new Fields::Bar( id => '1ba356f', info => 'standard bar'); | |
| 49 | |
| 50 $obj->{name} eq 'Bar' or failed "A value of 'name' property is wrong","Expected: 'Bar'","Got: '$obj->{name}'"; | |
| 51 $obj->{id} eq '1ba356f' or failed "A value of 'id' property is wrong","Expected: '1ba356f'","Got: '$obj->{id}'"; | |
| 52 }; | |
| 53 | |
| 54 1; |
