diff _test/Test/Object/Common.pm @ 3:2e546a5175dd

in developing
author Sergey
date Tue, 11 Aug 2009 17:45:52 +0400
parents
children 16ada169ca75
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Object/Common.pm	Tue Aug 11 17:45:52 2009 +0400
@@ -0,0 +1,106 @@
+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;