getting close to a 0.07 release
[gitmo/Class-MOP.git] / t / 002_class_precedence_list.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 6;
7
8 BEGIN {
9     use_ok('Class::MOP');   
10     use_ok('Class::MOP::Class');        
11 }
12
13 =pod
14
15   A
16  / \
17 B   C
18  \ / 
19   D
20
21 =cut
22
23 {
24     package My::A;
25     use metaclass;
26     package My::B;
27     our @ISA = ('My::A');
28     package My::C;
29     our @ISA = ('My::A');    
30     package My::D;       
31     our @ISA = ('My::B', 'My::C');         
32 }
33
34 is_deeply(
35     [ My::D->meta->class_precedence_list ], 
36     [ 'My::D', 'My::B', 'My::A', 'My::C', 'My::A' ], 
37     '... My::D->meta->class_precedence_list == (D B A C A)');
38
39 =pod
40
41  A <-+
42  |   |
43  B   |
44  |   |
45  C --+
46
47 =cut
48
49 {
50     package My::2::A;
51     use metaclass;    
52     our @ISA = ('My::2::C');
53         
54     package My::2::B;
55     our @ISA = ('My::2::A');
56     
57     package My::2::C;
58     our @ISA = ('My::2::B');           
59 }
60
61 eval { My::2::B->meta->class_precedence_list };
62 ok($@, '... recursive inheritance breaks correctly :)');
63
64 =pod
65
66  +--------+
67  |    A   |
68  |   / \  |
69  +->B   C-+
70      \ / 
71       D
72
73 =cut
74
75 {
76     package My::3::A;
77     use metaclass;    
78     package My::3::B;
79     our @ISA = ('My::3::A');
80     package My::3::C;
81     our @ISA = ('My::3::A', 'My::3::B');    
82     package My::3::D;       
83     our @ISA = ('My::3::B', 'My::3::C');         
84 }
85
86 is_deeply(
87     [ My::3::D->meta->class_precedence_list ], 
88     [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C', 'My::3::A', 'My::3::B', 'My::3::A' ], 
89     '... My::3::D->meta->class_precedence_list == (D B A C A B A)');
90
91 =pod
92
93 Test all the class_precedence_lists 
94 using Perl's own dispatcher to check 
95 against.
96
97 =cut
98
99 my @CLASS_PRECEDENCE_LIST;
100
101 {
102     package Foo;
103     use metaclass;    
104     
105     sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo' }    
106     
107     package Bar;
108     our @ISA = ('Foo');
109     
110     sub CPL { 
111         push @CLASS_PRECEDENCE_LIST => 'Bar';
112         $_[0]->SUPER::CPL();
113     }       
114     
115     package Baz;
116     use metaclass;    
117     our @ISA = ('Bar');
118     
119     sub CPL { 
120         push @CLASS_PRECEDENCE_LIST => 'Baz';
121         $_[0]->SUPER::CPL();
122     }       
123     
124     package Foo::Bar;
125     our @ISA = ('Baz');
126     
127     sub CPL { 
128         push @CLASS_PRECEDENCE_LIST => 'Foo::Bar';
129         $_[0]->SUPER::CPL();
130     }    
131     
132     package Foo::Bar::Baz;
133     our @ISA = ('Foo::Bar');
134     
135     sub CPL { 
136         push @CLASS_PRECEDENCE_LIST => 'Foo::Bar::Baz';
137         $_[0]->SUPER::CPL();
138     }    
139
140 }
141
142 Foo::Bar::Baz->CPL();
143
144 is_deeply(
145     [ Foo::Bar::Baz->meta->class_precedence_list ], 
146     [ @CLASS_PRECEDENCE_LIST ], 
147     '... Foo::Bar::Baz->meta->class_precedence_list == @CLASS_PRECEDENCE_LIST');
148