|
164
|
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 {
|
|
194
|
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 }
|
|
164
|
39 }
|
|
|
40
|
|
|
41 test constructObject => sub {
|
|
194
|
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}'";
|
|
164
|
45 };
|
|
|
46
|
|
|
47 test inheritance => sub {
|
|
194
|
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}'";
|
|
164
|
52 };
|
|
|
53
|
|
180
|
54 1;
|
