1#!/usr/bin/perl
2
3use strict;
4use warnings;
5use utf8;
6use open qw( :utf8 :std );
7
8require q(./test.pl); plan(tests => 5);
9
10=pod
11
12This tests the classic diamond inheritance pattern.
13
14   <A>
15  /   \
16<B>   <C>
17  \   /
18   <D>
19
20=cut
21
22{
23    package Di��mond_A;
24    use mro 'c3'; 
25    sub ������ { 'Di��mond_A::������' }
26    sub f��� { 'Di��mond_A::f���' }       
27}
28{
29    package Di��mond_B;
30    use base 'Di��mond_A';
31    use mro 'c3';     
32    sub f��� { 'Di��mond_B::f��� => ' . (shift)->next::method() }       
33}
34{
35    package Di��mond_C;
36    use mro 'c3';    
37    use base 'Di��mond_A';     
38
39    sub ������ { 'Di��mond_C::������ => ' . (shift)->next::method() }
40    sub f��� { 'Di��mond_C::f��� => ' . (shift)->next::method() }   
41}
42{
43    package Di��mond_D;
44    use base ('Di��mond_B', 'Di��mond_C');
45    use mro 'c3'; 
46    
47    sub f��� { 'Di��mond_D::f��� => ' . (shift)->next::method() }   
48}
49
50ok(eq_array(
51    mro::get_linear_isa('Di��mond_D'),
52    [ qw(Di��mond_D Di��mond_B Di��mond_C Di��mond_A) ]
53), '... got the right MRO for Di��mond_D');
54
55is(Di��mond_D->������, 'Di��mond_C::������ => Di��mond_A::������', '... method resolved itself as expected');
56
57is(Di��mond_D->can('������')->('Di��mond_D'), 
58   'Di��mond_C::������ => Di��mond_A::������', 
59   '... can(method) resolved itself as expected');
60   
61is(UNIVERSAL::can("Di��mond_D", '������')->('Di��mond_D'), 
62   'Di��mond_C::������ => Di��mond_A::������', 
63   '... can(method) resolved itself as expected');
64
65is(Di��mond_D->f���, 
66    'Di��mond_D::f��� => Di��mond_B::f��� => Di��mond_C::f��� => Di��mond_A::f���', 
67    '... method f��� resolved itself as expected');
68