t/200_Class_C3_compatibility.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 =pod
   9
  10 This tests that Class::MOP works correctly
  11 with Class::C3 and it's somewhat insane
  12 approach to method resolution.
  13
  14 =cut
  15
  16 BEGIN {
  17     eval "use Class::C3";
  18     plan skip_all => "Class::C3 required for this test" if $@;
  19     plan tests => 7;
  20 }
  21
  22 {
  23     package Diamond_A;
  24     Class::C3->import;
  25     use metaclass; # everyone will just inherit this now :)
  26
  27     sub hello { 'Diamond_A::hello' }
  28 }
  29 {
  30     package Diamond_B;
  31     use base 'Diamond_A';
  32     Class::C3->import;
  33 }
  34 {
  35     package Diamond_C;
  36     Class::C3->import;
  37     use base 'Diamond_A';
  38
  39     sub hello { 'Diamond_C::hello' }
  40 }
  41 {
  42     package Diamond_D;
  43     use base ('Diamond_B', 'Diamond_C');
  44     Class::C3->import;
  45 }
  46
  47 # we have to manually initialize
  48 # Class::C3 since we potentially
  49 # skip this test if it is not present
  50 Class::C3::initialize();
  51
  52 is_deeply(
  53     [ Class::C3::calculateMRO('Diamond_D') ],
  54     [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ],
  55     '... got the right MRO for Diamond_D');
  56
  57 ok(Diamond_A->meta->has_method('hello'), '... A has a method hello');
  58 ok(!Diamond_B->meta->has_method('hello'), '... B does not have a method hello');
  59 ok(defined &Diamond_B::hello, '... B does have an alias to the method hello');
  60
  61 ok(Diamond_C->meta->has_method('hello'), '... C has a method hello');
  62 ok(!Diamond_D->meta->has_method('hello'), '... D does not have a method hello');
  63 ok(defined &Diamond_D::hello, '... D does have an alias to the method hello');