1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6require q(./test.pl); plan(tests => 10);
7
8use utf8;
9use open qw( :utf8 :std );
10
11=pod
12
13This tests the classic diamond inheritance pattern.
14
15   <A>
16  /   \
17<B>   <C>
18  \   /
19   <D>
20
21=cut
22
23{
24    package ���i������d_A;
25    use mro 'c3'; 
26    sub ���a�� { '���i������d_A::���a��' }        
27    sub ����� { '���i������d_A::�����' }
28}
29{
30    package ���i������d_B;
31    use base '���i������d_A';
32    use mro 'c3';    
33    sub ����� { '���i������d_B::����� => ' . (shift)->next::method() }         
34}
35{
36    package ���i������d_C;
37    use mro 'c3';    
38    use base '���i������d_A';     
39    sub ��� { '���i������d_C::���' }   
40    sub bu�� { '���i������d_C::bu��' }     
41    
42    sub wo��� { '���i������d_C::wo���' }
43    sub ma���b�� { '���i������d_C::ma���b��' }         
44}
45{
46    package ���i������d_D;
47    use base ('���i������d_B', '���i������d_C');
48    use mro 'c3'; 
49    sub ��� { '���i������d_D::��� => ' . (shift)->next::method() } 
50    sub ���a�� { '���i������d_D::���a�� => ' . (shift)->next::method() }   
51    sub bu�� { '���i������d_D::bu�� => ' . (shift)->�����() }  
52    sub fuz { '���i������d_D::fuz => ' . (shift)->next::method() }  
53    
54    sub wo��� { '���i������d_D::wo��� can => ' . ((shift)->next::can() ? 1 : 0) }
55    sub noz { '���i������d_D::noz can => ' . ((shift)->next::can() ? 1 : 0) }
56
57    sub ma���b�� { '���i������d_D::ma���b�� => ' . ((shift)->maybe::next::method() || 0) }
58    sub ���y��� { '���i������d_D::���y��� => ' .    ((shift)->maybe::next::method() || 0) }
59
60}
61
62ok(eq_array(
63    mro::get_linear_isa('���i������d_D'),
64    [ qw(���i������d_D ���i������d_B ���i������d_C ���i������d_A) ]
65), '... got the right MRO for ���i������d_D');
66
67is(���i������d_D->���, '���i������d_D::��� => ���i������d_C::���', '... skipped B and went to C correctly');
68is(���i������d_D->���a��, '���i������d_D::���a�� => ���i������d_A::���a��', '... skipped B & C and went to A correctly');
69is(���i������d_D->�����, '���i������d_B::����� => ���i������d_A::�����', '... called B method, skipped C and went to A correctly');
70is(���i������d_D->bu��, '���i������d_D::bu�� => ���i������d_B::����� => ���i������d_A::�����', '... called D method dispatched to , different method correctly');
71eval { ���i������d_D->fuz };
72like($@, qr/^No next::method 'fuz' found for ���i������d_D/u, '... cannot re-dispatch to a method which is not there');
73is(���i������d_D->wo���, '���i������d_D::wo��� can => 1', '... can re-dispatch figured out correctly');
74is(���i������d_D->noz, '���i������d_D::noz can => 0', '... cannot re-dispatch figured out correctly');
75
76is(���i������d_D->ma���b��, '���i������d_D::ma���b�� => ���i������d_C::ma���b��', '... redispatched D to C when it exists');
77is(���i������d_D->���y���, '���i������d_D::���y��� => 0', '... quietly failed redispatch from D');
78