t/mro/complex_c3.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5
   6 require q(./test.pl); plan(tests => 12);
   7
   8 =pod
   9
  10 This example is taken from: http://rt.cpan.org/Public/Bug/Display.html?id=20879
  11
  12                ---     ---     ---
  13 Level 5     8 | A | 9 | B | A | C |    (More General)
  14                ---     ---     ---       V
  15                   \     |     /          |
  16                    \    |    /           |
  17                     \   |   /            |
  18                      \  |  /             |
  19                        ---               |
  20 Level 4             7 | D |              |
  21                        ---               |
  22                       /   \              |
  23                      /     \             |
  24                   ---       ---          |
  25 Level 3        4 | G |   6 | E |         |
  26                   ---       ---          |
  27                    |         |           |
  28                    |         |           |
  29                   ---       ---          |
  30 Level 2        3 | H |   5 | F |         |
  31                   ---       ---          |
  32                       \   /  |           |
  33                        \ /   |           |
  34                         \    |           |
  35                        / \   |           |
  36                       /   \  |           |
  37                   ---       ---          |
  38 Level 1        1 | J |   2 | I |         |
  39                   ---       ---          |
  40                     \       /            |
  41                      \     /             |
  42                        ---               v
  43 Level 0             0 | K |            (More Specialized)
  44                        ---
  45
  46
  47 0123456789A
  48 KJIHGFEDABC
  49
  50 =cut
  51
  52 {
  53     package Test::A; use mro 'c3';
  54
  55     package Test::B; use mro 'c3';
  56
  57     package Test::C; use mro 'c3';
  58
  59     package Test::D; use mro 'c3';
  60     use base qw/Test::A Test::B Test::C/;
  61
  62     package Test::E; use mro 'c3';
  63     use base qw/Test::D/;
  64
  65     package Test::F; use mro 'c3';
  66     use base qw/Test::E/;
  67     sub testmeth { "wrong" }
  68
  69     package Test::G; use mro 'c3';
  70     use base qw/Test::D/;
  71
  72     package Test::H; use mro 'c3';
  73     use base qw/Test::G/;
  74
  75     package Test::I; use mro 'c3';
  76     use base qw/Test::H Test::F/;
  77     sub testmeth { "right" }
  78
  79     package Test::J; use mro 'c3';
  80     use base qw/Test::F/;
  81
  82     package Test::K; use mro 'c3';
  83     use base qw/Test::J Test::I/;
  84     sub testmeth { shift->next::method }
  85 }
  86
  87 ok(eq_array(
  88     mro::get_linear_isa('Test::A'),
  89     [ qw(Test::A) ]
  90 ), '... got the right C3 merge order for Test::A');
  91
  92 ok(eq_array(
  93     mro::get_linear_isa('Test::B'),
  94     [ qw(Test::B) ]
  95 ), '... got the right C3 merge order for Test::B');
  96
  97 ok(eq_array(
  98     mro::get_linear_isa('Test::C'),
  99     [ qw(Test::C) ]
 100 ), '... got the right C3 merge order for Test::C');
 101
 102 ok(eq_array(
 103     mro::get_linear_isa('Test::D'),
 104     [ qw(Test::D Test::A Test::B Test::C) ]
 105 ), '... got the right C3 merge order for Test::D');
 106
 107 ok(eq_array(
 108     mro::get_linear_isa('Test::E'),
 109     [ qw(Test::E Test::D Test::A Test::B Test::C) ]
 110 ), '... got the right C3 merge order for Test::E');
 111
 112 ok(eq_array(
 113     mro::get_linear_isa('Test::F'),
 114     [ qw(Test::F Test::E Test::D Test::A Test::B Test::C) ]
 115 ), '... got the right C3 merge order for Test::F');
 116
 117 ok(eq_array(
 118     mro::get_linear_isa('Test::G'),
 119     [ qw(Test::G Test::D Test::A Test::B Test::C) ]
 120 ), '... got the right C3 merge order for Test::G');
 121
 122 ok(eq_array(
 123     mro::get_linear_isa('Test::H'),
 124     [ qw(Test::H Test::G Test::D Test::A Test::B Test::C) ]
 125 ), '... got the right C3 merge order for Test::H');
 126
 127 ok(eq_array(
 128     mro::get_linear_isa('Test::I'),
 129     [ qw(Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ]
 130 ), '... got the right C3 merge order for Test::I');
 131
 132 ok(eq_array(
 133     mro::get_linear_isa('Test::J'),
 134     [ qw(Test::J Test::F Test::E Test::D Test::A Test::B Test::C) ]
 135 ), '... got the right C3 merge order for Test::J');
 136
 137 ok(eq_array(
 138     mro::get_linear_isa('Test::K'),
 139     [ qw(Test::K Test::J Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ]
 140 ), '... got the right C3 merge order for Test::K');
 141
 142 is(Test::K->testmeth(), "right", 'next::method working ok');