annotate _test/Test/Object/Fields.pm @ 427:09e0086a82a7 ref20150831 tip

Merge
author cin
date Tue, 15 May 2018 00:51:33 +0300
parents 4d0e1962161c
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
164
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
1 package Test::Object::Fields;
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
2 use strict;
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
3 use warnings;
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
4
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
5 use base qw( IMPL::Test::Unit );
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
6 use IMPL::Test qw(test failed cmparray);
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
7
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
8 __PACKAGE__->PassThroughArgs;
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
9
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
10 {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
11 package Fields::Foo;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
12 use base qw(IMPL::Object::Fields);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
13
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
14 use fields qw(name info);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
15
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
16 sub CTOR {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
17 my ($this,$name,$info) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
18
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
19 $this->{name} = $name;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
20 $this->{info} = $info;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
21 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
22
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
23 package Fields::Bar;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
24 use base qw(Fields::Foo);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
25 use fields qw(id);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
26
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
27 our %CTOR = (
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
28 'Fields::Foo' => sub {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
29 my %args = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
30 Bar => $args{info};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
31 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
32 );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
33
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
34 sub CTOR {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
35 my ($this,%args) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
36
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
37 $this->{id} = $args{id};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
38 }
164
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
39 }
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
40
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
41 test constructObject => sub {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
42 my $obj = new Fields::Foo( Peter => '34-fg-78' );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
43
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
44 $obj->{name} eq 'Peter' or failed "A value of 'name' field is wrong","Expected: 'Peter'","Got: '$obj->{name}'";
164
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
45 };
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
46
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
47 test inheritance => sub {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
48 my $obj = new Fields::Bar( id => '1ba356f', info => 'standard bar');
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
49
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
50 $obj->{name} eq 'Bar' or failed "A value of 'name' property is wrong","Expected: 'Bar'","Got: '$obj->{name}'";
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
51 $obj->{id} eq '1ba356f' or failed "A value of 'id' property is wrong","Expected: '1ba356f'","Got: '$obj->{id}'";
164
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
52 };
eb3e9861a761 SQL traits in progress
wizard
parents:
diff changeset
53
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 164
diff changeset
54 1;