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; |