distar-ify
[gitmo/Class-C3.git] / t / 01_MRO.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 10;
7
8 =pod
9
10 This tests the classic diamond inheritence pattern.
11
12    <A>
13   /   \
14 <B>   <C>
15   \   /
16    <D>
17
18 =cut
19
20 {
21     package Diamond_A;
22     use Class::C3; 
23     sub hello { 'Diamond_A::hello' }
24 }
25 {
26     package Diamond_B;
27     use base 'Diamond_A';
28     use Class::C3;     
29 }
30 {
31     package Diamond_C;
32     use Class::C3;    
33     use base 'Diamond_A';     
34     
35     sub hello { 'Diamond_C::hello' }
36 }
37 {
38     package Diamond_D;
39     use base ('Diamond_B', 'Diamond_C');
40     use Class::C3;    
41 }
42
43 Class::C3::initialize();
44
45
46 is_deeply(
47     [ Class::C3::calculateMRO('Diamond_D') ],
48     [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ],
49     '... got the right MRO for Diamond_D');
50
51 is(Diamond_D->hello, 'Diamond_C::hello', '... method resolved itself as expected');
52
53 is(Diamond_D->can('hello')->(), 'Diamond_C::hello', '... can(method) resolved itself as expected');
54 is(UNIVERSAL::can("Diamond_D", 'hello')->(), 'Diamond_C::hello', '... can(method) resolved itself as expected');
55
56 # now undo the C3
57 Class::C3::uninitialize();
58
59 is(Diamond_D->hello, 'Diamond_A::hello', '... old method resolution has been restored');
60
61 is(Diamond_D->can('hello')->(), 'Diamond_A::hello', '... can(method) resolution has been restored');
62 is(UNIVERSAL::can("Diamond_D", 'hello')->(), 'Diamond_A::hello', '... can(method) resolution has been restored');
63
64 Class::C3::initialize();
65
66 is(Diamond_D->hello, 'Diamond_C::hello', '... C3 method restored itself as expected');
67
68 is(Diamond_D->can('hello')->(), 'Diamond_C::hello', '... C3 can(method) restored itself as expected');
69 is(UNIVERSAL::can("Diamond_D", 'hello')->(), 'Diamond_C::hello', '... C3 can(method) restored itself as expected');