Mercurial > pub > Impl
annotate _test/Test/Object/Common.pm @ 401:16ff604298c7
minor fixes
author | cin |
---|---|
date | Thu, 15 May 2014 18:24:28 +0400 |
parents | ced5937ff21a |
children |
rev | line source |
---|---|
49 | 1 package Test::Object::Common; |
2 use strict; | |
3 use warnings; | |
4 | |
381
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
5 use IMPL::Test qw(test failed cmparray assert); |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
6 use IMPL::declare { |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
7 base => [ |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
8 'IMPL::Test::Unit' => '@_' |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
9 ] |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
10 }; |
49 | 11 |
12 { | |
13 package Foo; | |
165 | 14 use parent qw(IMPL::Object); |
49 | 15 |
16 sub CTOR { | |
17 my ($this,$refarg) = @_; | |
18 $$refarg = 1; | |
19 } | |
20 | |
21 package Bar; | |
165 | 22 use parent qw(-norequire Foo); |
49 | 23 |
24 __PACKAGE__->PassThroughArgs; | |
25 | |
26 sub CTOR { | |
27 my ($this,$ref,$array) = @_; | |
28 | |
29 push @$array,__PACKAGE__; | |
30 } | |
31 | |
32 package Baz; | |
165 | 33 use parent qw(-norequire Bar); |
49 | 34 |
35 our %CTOR = ( | |
36 Bar => sub { | |
37 my $t; | |
38 (\$t,$_[0]); | |
39 } | |
40 ); | |
41 | |
42 sub CTOR { | |
43 my ($this,$array) = @_; | |
44 push @$array,__PACKAGE__; | |
45 } | |
46 | |
47 package Zoo; | |
165 | 48 use parent qw(-norequire Bar); |
49 | 49 |
50 __PACKAGE__->PassThroughArgs; | |
51 | |
52 sub CTOR { | |
53 my ($this,$ref,$array) = @_; | |
54 | |
55 push @$array,__PACKAGE__; | |
56 }; | |
57 | |
58 package Complex; | |
165 | 59 use parent qw(-norequire Baz Zoo); |
49 | 60 |
61 our %CTOR = ( | |
62 Baz => sub { @_ }, | |
63 Zoo => sub { | |
64 my $t; | |
65 (\$t,$_[0]); | |
66 } | |
67 ); | |
68 | |
69 } | |
70 | |
71 test Creation => sub { | |
72 my $flag = 0; | |
73 | |
74 my $obj = new Foo(\$flag); | |
75 | |
76 die new IMPL::Test::FailException("Object is undef") unless $obj; | |
77 die new IMPL::Test::FailException("Contructor doesn't run") unless $obj; | |
78 }; | |
79 | |
80 test SimpleInheritance => sub { | |
81 my $sequence = []; | |
82 my $flag = 0; | |
83 my $obj = new Bar(\$flag,$sequence); | |
84 | |
85 failed "Object is undef" unless $obj; | |
86 failed "Base class constructor isn't called" unless $flag; | |
87 failed "Class constructor isn't called" unless @$sequence; | |
88 }; | |
89 | |
90 test SimpleInheritance2 => sub { | |
91 my $sequence = []; | |
92 my $expected = [qw(Bar Baz)]; | |
93 my $obj = new Baz($sequence); | |
94 | |
95 failed "Object is undef" unless $obj; | |
96 failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected; | |
97 }; | |
98 | |
99 test MultipleInheritance => sub { | |
100 my $sequence = []; | |
101 my $expected = [qw(Bar Baz Bar Zoo)]; | |
102 my $obj = new Complex($sequence); | |
103 | |
104 failed "Object is undef" unless $obj; | |
105 failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected; | |
106 }; | |
107 | |
381
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
108 test CustomGetterSetter => sub { |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
109 my $obj = Test::Object::Common::Bar->new(); |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
110 |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
111 assert($obj->custom eq 'default'); |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
112 $obj->custom('new_value'); |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
113 assert($obj->custom eq 'new_value'); |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
114 }; |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
115 |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
116 package Test::Object::Common::Bar; |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
117 use IMPL::Const qw(:prop); |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
118 use IMPL::declare { |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
119 base => [ |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
120 'IMPL::Object' => undef |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
121 ], |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
122 props => [ |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
123 custom => { |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
124 get => '_getCustom', |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
125 set => '_setCustom', |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
126 direct => 1 |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
127 } |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
128 ] |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
129 }; |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
130 |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
131 sub _getCustom { |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
132 shift->{$custom} || 'default'; |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
133 } |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
134 |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
135 sub _setCustom { |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
136 my ($this,$value) = @_; |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
137 $this->{$custom} = $value; |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
138 } |
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
165
diff
changeset
|
139 |
49 | 140 1; |