t/06_MRO.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 3;
   7
   8 BEGIN {
   9     use_ok('Class::C3');
  10     # uncomment this line, and re-run the
  11     # test to see the normal p5 dispatch order
  12     #$Class::C3::TURN_OFF_C3 = 1;
  13 }
  14
  15 =pod
  16
  17 This tests a strange bug found by Matt S. Trout
  18 while building DBIx::Class. Thanks Matt!!!!
  19
  20    <A>
  21   /   \
  22 <C>   <B>
  23   \   /
  24    <D>
  25
  26 =cut
  27
  28 {
  29     package Diamond_A;
  30     use Class::C3;
  31
  32     sub foo { 'Diamond_A::foo' }
  33 }
  34 {
  35     package Diamond_B;
  36     use base 'Diamond_A';
  37     use Class::C3;
  38
  39     sub foo { 'Diamond_B::foo => ' . (shift)->next::method }
  40 }
  41 {
  42     package Diamond_C;
  43     use Class::C3;
  44     use base 'Diamond_A';
  45
  46 }
  47 {
  48     package Diamond_D;
  49     use base ('Diamond_C', 'Diamond_B');
  50     use Class::C3;
  51
  52     sub foo { 'Diamond_D::foo => ' . (shift)->next::method }
  53 }
  54
  55 Class::C3::initialize();
  56
  57 is_deeply(
  58     [ Class::C3::calculateMRO('Diamond_D') ],
  59     [ qw(Diamond_D Diamond_C Diamond_B Diamond_A) ],
  60     '... got the right MRO for Diamond_D');
  61
  62 is(Diamond_D->foo,
  63    'Diamond_D::foo => Diamond_B::foo => Diamond_A::foo',
  64    '... got the right next::method dispatch path');