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;