1#!./perl
2
3use strict;
4use warnings;
5
6use utf8;
7use open qw( :utf8 :std );
8
9require q(./test.pl); plan(tests => 2);
10
11=pod
12
13This tests a strange bug found by Matt S. Trout
14while building DBIx::Class. Thanks Matt!!!!
15
16   <A>
17  /   \
18<C>   <B>
19  \   /
20   <D>
21
22=cut
23
24{
25    package Ｄiᚪၚd_A;
26    use mro 'dfs';
27
28    sub ᕘ { 'Ｄiᚪၚd_A::ᕘ' }
29}
30{
31    package Ｄiᚪၚd_B;
32    use base 'Ｄiᚪၚd_A';
33    use mro 'dfs';
34
35    sub ᕘ { 'Ｄiᚪၚd_B::ᕘ => ' . (shift)->SUPER::ᕘ }
36}
37{
38    package Ｄiᚪၚd_C;
39    use mro 'dfs';
40    use base 'Ｄiᚪၚd_A';
41
42}
43{
44    package Ｄiᚪၚd_D;
45    use base ('Ｄiᚪၚd_C', 'Ｄiᚪၚd_B');
46    use mro 'dfs';
47
48    sub ᕘ { 'Ｄiᚪၚd_D::ᕘ => ' . (shift)->SUPER::ᕘ }
49}
50
51ok(eq_array(
52    mro::get_linear_isa('Ｄiᚪၚd_D'),
53    [ qw(Ｄiᚪၚd_D Ｄiᚪၚd_C Ｄiᚪၚd_A Ｄiᚪၚd_B) ]
54), '... got the right MRO for Ｄiᚪၚd_D');
55
56is(Ｄiᚪၚd_D->ᕘ,
57   'Ｄiᚪၚd_D::ᕘ => Ｄiᚪၚd_A::ᕘ',
58   '... got the right next::method dispatch path');
59