1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More tests => 5; 7 8BEGIN { use_ok('Class::C3::XS') } 9 10=pod 11 12This tests the classic diamond inheritence pattern. 13 14 <A> 15 / \ 16<B> <C> 17 \ / 18 <D> 19 20=cut 21 22{ 23 package Diamond_A; 24 sub hello { 'Diamond_A::hello' } 25 sub foo { 'Diamond_A::foo' } 26} 27{ 28 package Diamond_B; 29 use base 'Diamond_A'; 30 sub foo { 'Diamond_B::foo => ' . (shift)->next::method() } 31} 32{ 33 package Diamond_C; 34 use base 'Diamond_A'; 35 36 sub hello { 'Diamond_C::hello => ' . (shift)->next::method() } 37 sub foo { 'Diamond_C::foo => ' . (shift)->next::method() } 38} 39{ 40 package Diamond_D; 41 use base ('Diamond_B', 'Diamond_C'); 42 43 sub foo { 'Diamond_D::foo => ' . (shift)->next::method() } 44} 45 46is(Diamond_C->hello, 'Diamond_C::hello => Diamond_A::hello', '... method resolved itself as expected'); 47 48is(Diamond_C->can('hello')->('Diamond_C'), 49 'Diamond_C::hello => Diamond_A::hello', 50 '... can(method) resolved itself as expected'); 51 52is(UNIVERSAL::can("Diamond_C", 'hello')->('Diamond_C'), 53 'Diamond_C::hello => Diamond_A::hello', 54 '... can(method) resolved itself as expected'); 55 56is(Diamond_D->foo, 57 'Diamond_D::foo => Diamond_B::foo => Diamond_C::foo => Diamond_A::foo', 58 '... method foo resolved itself as expected'); 59