Mercurial > pub > Impl

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
in developing
author Sergey
date Tue, 11 Aug 2009 17:45:52 +0400
parents
children 16ada169ca75
comparison
equal deleted inserted replaced
2:78cd38551534 3:2e546a5175dd
1 package Test::Object::Common;
2 use strict;
3 use warnings;
4
5 use base qw( IMPL::Test::Unit );
6 use IMPL::Test qw(test failed cmparray);
7
8 __PACKAGE__->PassThroughArgs;
9
10 {
11 package Foo;
12 use base qw(IMPL::Object);
13
14 sub CTOR {
15 my ($this,$refarg) = @_;
16 $$refarg = 1;
17 }
18
19 package Bar;
20 use base qw(Foo);
21
22 __PACKAGE__->PassThroughArgs;
23
24 sub CTOR {
25 my ($this,$ref,$array) = @_;
26
27 push @$array,__PACKAGE__;
28 }
29
30 package Baz;
31 use base qw(Bar);
32
33 our %CTOR = (
34 Bar => sub {
35 my $t;
36 (\$t,$_[0]);
37 }
38 );
39
40 sub CTOR {
41 my ($this,$array) = @_;
42 push @$array,__PACKAGE__;
43 }
44
45 package Zoo;
46 use base qw(Bar);
47
48 __PACKAGE__->PassThroughArgs;
49
50 sub CTOR {
51 my ($this,$ref,$array) = @_;
52
53 push @$array,__PACKAGE__;
54 };
55
56 package Complex;
57 use base qw(Baz Zoo);
58
59 our %CTOR = (
60 Baz => sub { @_ },
61 Zoo => sub {
62 my $t;
63 (\$t,$_[0]);
64 }
65 );
66
67 }
68
69 test Creation => sub {
70 my $flag = 0;
71
72 my $obj = new Foo(\$flag);
73
74 die new IMPL::Test::FailException("Object is undef") unless $obj;
75 die new IMPL::Test::FailException("Contructor doesn't run") unless $obj;
76 };
77
78 test SimpleInheritance => sub {
79 my $sequence = [];
80 my $flag = 0;
81 my $obj = new Bar(\$flag,$sequence);
82
83 failed "Object is undef" unless $obj;
84 failed "Base class constructor isn't called" unless $flag;
85 failed "Class constructor isn't called" unless @$sequence;
86 };
87
88 test SimpleInheritance2 => sub {
89 my $sequence = [];
90 my $expected = [qw(Bar Baz)];
91 my $obj = new Baz($sequence);
92
93 failed "Object is undef" unless $obj;
94 failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected;
95 };
96
97 test MultipleInheritance => sub {
98 my $sequence = [];
99 my $expected = [qw(Bar Baz Bar Zoo)];
100 my $obj = new Complex($sequence);
101
102 failed "Object is undef" unless $obj;
103 failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected;
104 };
105
106 1;