t/01_MRO.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 10;
   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     use Class::C3;
  23     sub hello { 'Diamond_A::hello' }
  24 }
  25 {
  26     package Diamond_B;
  27     use base 'Diamond_A';
  28     use Class::C3;
  29 }
  30 {
  31     package Diamond_C;
  32     use Class::C3;
  33     use base 'Diamond_A';
  34
  35     sub hello { 'Diamond_C::hello' }
  36 }
  37 {
  38     package Diamond_D;
  39     use base ('Diamond_B', 'Diamond_C');
  40     use Class::C3;
  41 }
  42
  43 Class::C3::initialize();
  44
  45
  46 is_deeply(
  47     [ Class::C3::calculateMRO('Diamond_D') ],
  48     [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ],
  49     '... got the right MRO for Diamond_D');
  50
  51 is(Diamond_D->hello, 'Diamond_C::hello', '... method resolved itself as expected');
  52
  53 is(Diamond_D->can('hello')->(), 'Diamond_C::hello', '... can(method) resolved itself as expected');
  54 is(UNIVERSAL::can("Diamond_D", 'hello')->(), 'Diamond_C::hello', '... can(method) resolved itself as expected');
  55
  56 # now undo the C3
  57 Class::C3::uninitialize();
  58
  59 is(Diamond_D->hello, 'Diamond_A::hello', '... old method resolution has been restored');
  60
  61 is(Diamond_D->can('hello')->(), 'Diamond_A::hello', '... can(method) resolution has been restored');
  62 is(UNIVERSAL::can("Diamond_D", 'hello')->(), 'Diamond_A::hello', '... can(method) resolution has been restored');
  63
  64 Class::C3::initialize();
  65
  66 is(Diamond_D->hello, 'Diamond_C::hello', '... C3 method restored itself as expected');
  67
  68 is(Diamond_D->can('hello')->(), 'Diamond_C::hello', '... C3 can(method) restored itself as expected');
  69 is(UNIVERSAL::can("Diamond_D", 'hello')->(), 'Diamond_C::hello', '... C3 can(method) restored itself as expected');