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