t/mro/basic_05_c3.t

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