Mercurial > pub > Impl
annotate _test/Test/Object/Common.pm @ 408:5c80e33f1218 ref20150831
added 'coarsen' function
| author | cin |
|---|---|
| date | Mon, 07 Sep 2015 01:35:25 +0300 |
| 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; |