t/01_MRO.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 2;
   7
   8 BEGIN {
   9     use_ok('Class::C3::XS');
  10 }
  11
  12 =pod
  13
  14 This tests the classic diamond inheritence pattern.
  15
  16    <A>
  17   /   \
  18 <B>   <C>
  19   \   /
  20    <D>
  21
  22 =cut
  23
  24 {
  25     package Diamond_A;
  26     our @ISA = qw//;
  27 }
  28 {
  29     package Diamond_B;
  30     use base 'Diamond_A';
  31 }
  32 {
  33     package Diamond_C;
  34     use base 'Diamond_A';
  35 }
  36 {
  37     package Diamond_D;
  38     use base ('Diamond_B', 'Diamond_C');
  39 }
  40
  41 is_deeply(
  42     [ Class::C3::XS::calculateMRO('Diamond_D') ],
  43     [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ],
  44     '... got the right MRO for Diamond_D');