t/002_class_precedence_list.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 6;
   7
   8 BEGIN {
   9     use_ok('Class::MOP');
  10     use_ok('Class::MOP::Class');
  11 }
  12
  13 =pod
  14
  15   A
  16  / \
  17 B   C
  18  \ /
  19   D
  20
  21 =cut
  22
  23 {
  24     package My::A;
  25     package My::B;
  26     our @ISA = ('My::A');
  27     package My::C;
  28     our @ISA = ('My::A');
  29     package My::D;
  30     our @ISA = ('My::B', 'My::C');
  31 }
  32
  33 is_deeply(
  34     [ Class::MOP::Class->initialize('My::D')->class_precedence_list ],
  35     [ 'My::D', 'My::B', 'My::A', 'My::C', 'My::A' ],
  36     '... My::D->meta->class_precedence_list == (D B A C A)');
  37
  38 =pod
  39
  40  A <-+
  41  |   |
  42  B   |
  43  |   |
  44  C --+
  45
  46 =cut
  47
  48 {
  49     package My::2::A;
  50     our @ISA = ('My::2::C');
  51
  52     package My::2::B;
  53     our @ISA = ('My::2::A');
  54
  55     package My::2::C;
  56     our @ISA = ('My::2::B');
  57 }
  58
  59 eval { Class::MOP::Class->initialize('My::2::B')->class_precedence_list };
  60 ok($@, '... recursive inheritance breaks correctly :)');
  61
  62 =pod
  63
  64  +--------+
  65  |    A   |
  66  |   / \  |
  67  +->B   C-+
  68      \ /
  69       D
  70
  71 =cut
  72
  73 {
  74     package My::3::A;
  75     package My::3::B;
  76     our @ISA = ('My::3::A');
  77     package My::3::C;
  78     our @ISA = ('My::3::A', 'My::3::B');
  79     package My::3::D;
  80     our @ISA = ('My::3::B', 'My::3::C');
  81 }
  82
  83 is_deeply(
  84     [ Class::MOP::Class->initialize('My::3::D')->class_precedence_list ],
  85     [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C', 'My::3::A', 'My::3::B', 'My::3::A' ],
  86     '... My::3::D->meta->class_precedence_list == (D B A C A B A)');
  87
  88 =pod
  89
  90 Test all the class_precedence_lists
  91 using Perl's own dispatcher to check
  92 against.
  93
  94 =cut
  95
  96 my @CLASS_PRECEDENCE_LIST;
  97
  98 {
  99     package Foo;
 100
 101     sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo' }
 102
 103     package Bar;
 104     our @ISA = ('Foo');
 105
 106     sub CPL {
 107         push @CLASS_PRECEDENCE_LIST => 'Bar';
 108         $_[0]->SUPER::CPL();
 109     }
 110
 111     package Baz;
 112     our @ISA = ('Bar');
 113
 114     sub CPL {
 115         push @CLASS_PRECEDENCE_LIST => 'Baz';
 116         $_[0]->SUPER::CPL();
 117     }
 118
 119     package Foo::Bar;
 120     our @ISA = ('Baz');
 121
 122     sub CPL {
 123         push @CLASS_PRECEDENCE_LIST => 'Foo::Bar';
 124         $_[0]->SUPER::CPL();
 125     }
 126
 127     package Foo::Bar::Baz;
 128     our @ISA = ('Foo::Bar');
 129
 130     sub CPL {
 131         push @CLASS_PRECEDENCE_LIST => 'Foo::Bar::Baz';
 132         $_[0]->SUPER::CPL();
 133     }
 134
 135 }
 136
 137 Foo::Bar::Baz->CPL();
 138
 139 is_deeply(
 140     [ Class::MOP::Class->initialize('Foo::Bar::Baz')->class_precedence_list ],
 141     [ @CLASS_PRECEDENCE_LIST ],
 142     '... Foo::Bar::Baz->meta->class_precedence_list == @CLASS_PRECEDENCE_LIST');
 143