annotate _test/Test/Object/Common.pm @ 40:ac21a032e7a9

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