t/06_MRO.t

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