Mercurial > pub > Impl
view _test/Test/Object/Common.pm @ 418:3f38dabaf5cc ref20150831
sync
author | cin |
---|---|
date | Mon, 28 Dec 2015 15:11:35 +0300 |
parents | ced5937ff21a |
children |
line wrap: on
line source
package Test::Object::Common; use strict; use warnings; use IMPL::Test qw(test failed cmparray assert); use IMPL::declare { base => [ 'IMPL::Test::Unit' => '@_' ] }; { package Foo; use parent qw(IMPL::Object); sub CTOR { my ($this,$refarg) = @_; $$refarg = 1; } package Bar; use parent qw(-norequire Foo); __PACKAGE__->PassThroughArgs; sub CTOR { my ($this,$ref,$array) = @_; push @$array,__PACKAGE__; } package Baz; use parent qw(-norequire Bar); our %CTOR = ( Bar => sub { my $t; (\$t,$_[0]); } ); sub CTOR { my ($this,$array) = @_; push @$array,__PACKAGE__; } package Zoo; use parent qw(-norequire Bar); __PACKAGE__->PassThroughArgs; sub CTOR { my ($this,$ref,$array) = @_; push @$array,__PACKAGE__; }; package Complex; use parent qw(-norequire Baz Zoo); our %CTOR = ( Baz => sub { @_ }, Zoo => sub { my $t; (\$t,$_[0]); } ); } test Creation => sub { my $flag = 0; my $obj = new Foo(\$flag); die new IMPL::Test::FailException("Object is undef") unless $obj; die new IMPL::Test::FailException("Contructor doesn't run") unless $obj; }; test SimpleInheritance => sub { my $sequence = []; my $flag = 0; my $obj = new Bar(\$flag,$sequence); failed "Object is undef" unless $obj; failed "Base class constructor isn't called" unless $flag; failed "Class constructor isn't called" unless @$sequence; }; test SimpleInheritance2 => sub { my $sequence = []; my $expected = [qw(Bar Baz)]; my $obj = new Baz($sequence); failed "Object is undef" unless $obj; failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected; }; test MultipleInheritance => sub { my $sequence = []; my $expected = [qw(Bar Baz Bar Zoo)]; my $obj = new Complex($sequence); failed "Object is undef" unless $obj; failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected; }; test CustomGetterSetter => sub { my $obj = Test::Object::Common::Bar->new(); assert($obj->custom eq 'default'); $obj->custom('new_value'); assert($obj->custom eq 'new_value'); }; package Test::Object::Common::Bar; use IMPL::Const qw(:prop); use IMPL::declare { base => [ 'IMPL::Object' => undef ], props => [ custom => { get => '_getCustom', set => '_setCustom', direct => 1 } ] }; sub _getCustom { shift->{$custom} || 'default'; } sub _setCustom { my ($this,$value) = @_; $this->{$custom} = $value; } 1;