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