Mercurial > pub > Impl
view _test/Test/Object/Common.pm @ 375:441e84031c7b
docs
author | cin |
---|---|
date | Fri, 10 Jan 2014 16:33:00 +0400 |
parents | 76515373dac0 |
children | ced5937ff21a |
line wrap: on
line source
package Test::Object::Common; use strict; use warnings; use parent qw( IMPL::Test::Unit ); use IMPL::Test qw(test failed cmparray); __PACKAGE__->PassThroughArgs; { 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; }; 1;