1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 5;
7
8BEGIN { use_ok('Class::C3::XS') }
9
10=pod
11
12This tests the classic diamond inheritence pattern.
13
14   <A>
15  /   \
16<B>   <C>
17  \   /
18   <D>
19
20=cut
21
22{
23    package Diamond_A;
24    sub hello { 'Diamond_A::hello' }
25    sub foo { 'Diamond_A::foo' }       
26}
27{
28    package Diamond_B;
29    use base 'Diamond_A';
30    sub foo { 'Diamond_B::foo => ' . (shift)->next::method() }       
31}
32{
33    package Diamond_C;
34    use base 'Diamond_A';     
35
36    sub hello { 'Diamond_C::hello => ' . (shift)->next::method() }
37    sub foo { 'Diamond_C::foo => ' . (shift)->next::method() }   
38}
39{
40    package Diamond_D;
41    use base ('Diamond_B', 'Diamond_C');
42    
43    sub foo { 'Diamond_D::foo => ' . (shift)->next::method() }   
44}
45
46is(Diamond_C->hello, 'Diamond_C::hello => Diamond_A::hello', '... method resolved itself as expected');
47
48is(Diamond_C->can('hello')->('Diamond_C'), 
49   'Diamond_C::hello => Diamond_A::hello', 
50   '... can(method) resolved itself as expected');
51   
52is(UNIVERSAL::can("Diamond_C", 'hello')->('Diamond_C'), 
53   'Diamond_C::hello => Diamond_A::hello', 
54   '... can(method) resolved itself as expected');
55
56is(Diamond_D->foo, 
57    'Diamond_D::foo => Diamond_B::foo => Diamond_C::foo => Diamond_A::foo', 
58    '... method foo resolved itself as expected');
59