t/30_next_method.t

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