Mercurial > pub > Impl
view _test/Test/Object/Common.pm @ 125:a4b0a819bbda
Small fixes in IMPL::DOM::Schema
author | wizard |
---|---|
date | Thu, 10 Jun 2010 17:43:51 +0400 |
parents | 16ada169ca75 |
children | 76515373dac0 |
line wrap: on
line source
package Test::Object::Common; use strict; use warnings; use base qw( IMPL::Test::Unit ); use IMPL::Test qw(test failed cmparray); __PACKAGE__->PassThroughArgs; { package Foo; use base qw(IMPL::Object); sub CTOR { my ($this,$refarg) = @_; $$refarg = 1; } package Bar; use base qw(Foo); __PACKAGE__->PassThroughArgs; sub CTOR { my ($this,$ref,$array) = @_; push @$array,__PACKAGE__; } package Baz; use base qw(Bar); our %CTOR = ( Bar => sub { my $t; (\$t,$_[0]); } ); sub CTOR { my ($this,$array) = @_; push @$array,__PACKAGE__; } package Zoo; use base qw(Bar); __PACKAGE__->PassThroughArgs; sub CTOR { my ($this,$ref,$array) = @_; push @$array,__PACKAGE__; }; package Complex; use base qw(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;