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 Diᚪၚd_A; 25 use mro 'c3'; 26 sub ᴮaȐ { 'Diᚪၚd_A::ᴮaȐ' } 27 sub 바ź { 'Diᚪၚd_A::바ź' } 28} 29{ 30 package Diᚪၚd_B; 31 use base 'Diᚪၚd_A'; 32 use mro 'c3'; 33 sub 바ź { 'Diᚪၚd_B::바ź => ' . (shift)->next::method() } 34} 35{ 36 package Diᚪၚd_C; 37 use mro 'c3'; 38 use base 'Diᚪၚd_A'; 39 sub ᕘ { 'Diᚪၚd_C::ᕘ' } 40 sub buƵ { 'Diᚪၚd_C::buƵ' } 41 42 sub woz { 'Diᚪၚd_C::woz' } 43 sub maᐇbʚ { 'Diᚪၚd_C::maᐇbʚ' } 44} 45{ 46 package Diᚪၚd_D; 47 use base ('Diᚪၚd_B', 'Diᚪၚd_C'); 48 use mro 'c3'; 49 sub ᕘ { 'Diᚪၚd_D::ᕘ => ' . (shift)->next::method() } 50 sub ᴮaȐ { 'Diᚪၚd_D::ᴮaȐ => ' . (shift)->next::method() } 51 sub buƵ { 'Diᚪၚd_D::buƵ => ' . (shift)->바ź() } 52 sub fuz { 'Diᚪၚd_D::fuz => ' . (shift)->next::method() } 53 54 sub woz { 'Diᚪၚd_D::woz can => ' . ((shift)->next::can() ? 1 : 0) } 55 sub noz { 'Diᚪၚd_D::noz can => ' . ((shift)->next::can() ? 1 : 0) } 56 57 sub maᐇbʚ { 'Diᚪၚd_D::maᐇbʚ => ' . ((shift)->maybe::next::method() || 0) } 58 sub ᒧyベ { 'Diᚪၚd_D::ᒧyベ => ' . ((shift)->maybe::next::method() || 0) } 59 60} 61 62ok(eq_array( 63 mro::get_linear_isa('Diᚪၚd_D'), 64 [ qw(Diᚪၚd_D Diᚪၚd_B Diᚪၚd_C Diᚪၚd_A) ] 65), '... got the right MRO for Diᚪၚd_D'); 66 67is(Diᚪၚd_D->ᕘ, 'Diᚪၚd_D::ᕘ => Diᚪၚd_C::ᕘ', '... skipped B and went to C correctly'); 68is(Diᚪၚd_D->ᴮaȐ, 'Diᚪၚd_D::ᴮaȐ => Diᚪၚd_A::ᴮaȐ', '... skipped B & C and went to A correctly'); 69is(Diᚪၚd_D->바ź, 'Diᚪၚd_B::바ź => Diᚪၚd_A::바ź', '... called B method, skipped C and went to A correctly'); 70is(Diᚪၚd_D->buƵ, 'Diᚪၚd_D::buƵ => Diᚪၚd_B::바ź => Diᚪၚd_A::바ź', '... called D method dispatched to , different method correctly'); 71eval { Diᚪၚd_D->fuz }; 72like($@, qr/^No next::method 'fuz' found for Diᚪၚd_D/u, '... cannot re-dispatch to a method which is not there'); 73is(Diᚪၚd_D->woz, 'Diᚪၚd_D::woz can => 1', '... can re-dispatch figured out correctly'); 74is(Diᚪၚd_D->noz, 'Diᚪၚd_D::noz can => 0', '... cannot re-dispatch figured out correctly'); 75 76is(Diᚪၚd_D->maᐇbʚ, 'Diᚪၚd_D::maᐇbʚ => Diᚪၚd_C::maᐇbʚ', '... redispatched D to C when it exists'); 77is(Diᚪၚd_D->ᒧyベ, 'Diᚪၚd_D::ᒧyベ => 0', '... quietly failed redispatch from D'); 78