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