t/mro/basic_02_dfs.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5
   6 require q(./test.pl); plan(tests => 10);
   7
   8 =pod
   9
  10 This example is take from: http://www.python.org/2.3/mro.html
  11
  12 "My first example"
  13 class O: pass
  14 class F(O): pass
  15 class E(O): pass
  16 class D(O): pass
  17 class C(D,F): pass
  18 class B(D,E): pass
  19 class A(B,C): pass
  20
  21
  22                           6
  23                          ---
  24 Level 3                 | O |                  (more general)
  25                       /  ---  \
  26                      /    |    \                      |
  27                     /     |     \                     |
  28                    /      |      \                    |
  29                   ---    ---    ---                   |
  30 Level 2        3 | D | 4| E |  | F | 5                |
  31                   ---    ---    ---                   |
  32                    \  \ _ /       |                   |
  33                     \    / \ _    |                   |
  34                      \  /      \  |                   |
  35                       ---      ---                    |
  36 Level 1            1 | B |    | C | 2                 |
  37                       ---      ---                    |
  38                         \      /                      |
  39                          \    /                      \ /
  40                            ---
  41 Level 0                 0 | A |                (more specialized)
  42                            ---
  43
  44 =cut
  45
  46 {
  47     package Test::O;
  48     use mro 'dfs';
  49
  50     package Test::F;
  51     use mro 'dfs';
  52     use base 'Test::O';
  53
  54     package Test::E;
  55     use base 'Test::O';
  56     use mro 'dfs';
  57
  58     sub C_or_E { 'Test::E' }
  59
  60     package Test::D;
  61     use mro 'dfs';
  62     use base 'Test::O';
  63
  64     sub C_or_D { 'Test::D' }
  65
  66     package Test::C;
  67     use base ('Test::D', 'Test::F');
  68     use mro 'dfs';
  69
  70     sub C_or_D { 'Test::C' }
  71     sub C_or_E { 'Test::C' }
  72
  73     package Test::B;
  74     use mro 'dfs';
  75     use base ('Test::D', 'Test::E');
  76
  77     package Test::A;
  78     use base ('Test::B', 'Test::C');
  79     use mro 'dfs';
  80 }
  81
  82 ok(eq_array(
  83     mro::get_linear_isa('Test::F'),
  84     [ qw(Test::F Test::O) ]
  85 ), '... got the right MRO for Test::F');
  86
  87 ok(eq_array(
  88     mro::get_linear_isa('Test::E'),
  89     [ qw(Test::E Test::O) ]
  90 ), '... got the right MRO for Test::E');
  91
  92 ok(eq_array(
  93     mro::get_linear_isa('Test::D'),
  94     [ qw(Test::D Test::O) ]
  95 ), '... got the right MRO for Test::D');
  96
  97 ok(eq_array(
  98     mro::get_linear_isa('Test::C'),
  99     [ qw(Test::C Test::D Test::O Test::F) ]
 100 ), '... got the right MRO for Test::C');
 101
 102 ok(eq_array(
 103     mro::get_linear_isa('Test::B'),
 104     [ qw(Test::B Test::D Test::O Test::E) ]
 105 ), '... got the right MRO for Test::B');
 106
 107 ok(eq_array(
 108     mro::get_linear_isa('Test::A'),
 109     [ qw(Test::A Test::B Test::D Test::O Test::E Test::C Test::F) ]
 110 ), '... got the right MRO for Test::A');
 111
 112 is(Test::A->C_or_D, 'Test::D', '... got the expected method output');
 113 is(Test::A->can('C_or_D')->(), 'Test::D', '... can got the expected method output');
 114 is(Test::A->C_or_E, 'Test::E', '... got the expected method output');
 115 is(Test::A->can('C_or_E')->(), 'Test::E', '... can got the expected method output');