t/200_Class_C3_compatibility.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 8;
   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     use_ok('Class::MOP');
  18 }
  19
  20 {
  21     package Diamond_A;
  22     use mro 'c3';
  23     use metaclass; # everyone will just inherit this now :)
  24
  25     sub hello { 'Diamond_A::hello' }
  26 }
  27 {
  28     package Diamond_B;
  29     use mro 'c3';
  30     use base 'Diamond_A';
  31 }
  32 {
  33     package Diamond_C;
  34     use mro 'c3';
  35     use base 'Diamond_A';
  36
  37     sub hello { 'Diamond_C::hello' }
  38 }
  39 {
  40     package Diamond_D;
  41     use mro 'c3';
  42     use base ('Diamond_B', 'Diamond_C');
  43 }
  44
  45 # we have to manually initialize
  46 # Class::C3 since we potentially
  47 # skip this test if it is not present
  48 Class::C3::initialize();
  49
  50 is_deeply(
  51 #    [ Class::C3::calculateMRO('Diamond_D') ],
  52     [ Diamond_D->meta->class_precedence_list ],
  53     [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ],
  54     '... got the right MRO for Diamond_D');
  55
  56 ok(Diamond_A->meta->has_method('hello'), '... A has a method hello');
  57 ok(!Diamond_B->meta->has_method('hello'), '... B does not have a method hello');
  58
  59 ok(Diamond_C->meta->has_method('hello'), '... C has a method hello');
  60 ok(!Diamond_D->meta->has_method('hello'), '... D does not have a method hello');
  61
  62 SKIP: {
  63     skip "C3 does not make aliases on 5.9.5+", 2 if $] > 5.009_004;
  64     ok(defined &Diamond_B::hello, '... B does have an alias to the method hello');
  65     ok(defined &Diamond_D::hello, '... D does have an alias to the method hello');
  66 }