t/mro/basic_05_c3.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5
   6 require q(./test.pl); plan(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 mro 'c3';
  24
  25     sub foo { 'Diamond_A::foo' }
  26 }
  27 {
  28     package Diamond_B;
  29     use base 'Diamond_A';
  30     use mro 'c3';
  31
  32     sub foo { 'Diamond_B::foo => ' . (shift)->SUPER::foo }
  33 }
  34 {
  35     package Diamond_C;
  36     use mro 'c3';
  37     use base 'Diamond_A';
  38
  39 }
  40 {
  41     package Diamond_D;
  42     use base ('Diamond_C', 'Diamond_B');
  43     use mro 'c3';
  44
  45     sub foo { 'Diamond_D::foo => ' . (shift)->SUPER::foo }
  46 }
  47
  48 ok(eq_array(
  49     mro::get_linear_isa('Diamond_D'),
  50     [ qw(Diamond_D Diamond_C Diamond_B Diamond_A) ]
  51 ), '... got the right MRO for Diamond_D');
  52
  53 is(Diamond_D->foo,
  54    'Diamond_D::foo => Diamond_B::foo => Diamond_A::foo',
  55    '... got the right next::method dispatch path');