t/004_advanced_methods.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More no_plan => 1;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Class::MOP');
  11     use_ok('Class::MOP::Class');
  12 }
  13
  14 =pod
  15
  16 The following class hierarhcy is very contrived
  17 and totally horrid (it won't work under C3 even),
  18 but it tests a number of aspect of this module.
  19
  20 A more real-world example would be a nice addition :)
  21
  22 =cut
  23
  24 {
  25     package Foo;
  26
  27     sub BUILD { 'Foo::BUILD' }
  28     sub foo { 'Foo::foo' }
  29
  30     package Bar;
  31     our @ISA = ('Foo');
  32
  33     sub BUILD { 'Bar::BUILD' }
  34     sub bar { 'Bar::bar' }
  35
  36     package Baz;
  37     our @ISA = ('Bar');
  38
  39     sub BUILD { 'Baz::BUILD' }
  40     sub baz { 'Baz::baz' }
  41     sub foo { 'Baz::foo' }
  42
  43     package Foo::Bar;
  44     our @ISA = ('Foo', 'Bar');
  45
  46     sub BUILD { 'Foo::Bar::BUILD' }
  47     sub foobar { 'Foo::Bar::foobar' }
  48
  49     package Foo::Bar::Baz;
  50     our @ISA = ('Foo', 'Bar', 'Baz');
  51
  52     sub BUILD { 'Foo::Bar::Baz::BUILD' }
  53     sub bar { 'Foo::Bar::Baz::bar' }
  54     sub foobarbaz { 'Foo::Bar::Baz::foobarbaz' }
  55 }
  56
  57 is_deeply(
  58     [ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Foo')->compute_all_applicable_methods() ],
  59     [
  60         {
  61             name  => 'BUILD',
  62             class => 'Foo',
  63             code  => \&Foo::BUILD
  64         },
  65         {
  66             name  => 'foo',
  67             class => 'Foo',
  68             code  => \&Foo::foo
  69         },
  70     ],
  71     '... got the right list of applicable methods for Foo');
  72
  73 is_deeply(
  74     [ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Bar')->compute_all_applicable_methods() ],
  75     [
  76         {
  77             name  => 'BUILD',
  78             class => 'Bar',
  79             code  => \&Bar::BUILD
  80         },
  81         {
  82             name  => 'bar',
  83             class => 'Bar',
  84             code  => \&Bar::bar
  85         },
  86         {
  87             name  => 'foo',
  88             class => 'Foo',
  89             code  => \&Foo::foo
  90         },
  91     ],
  92     '... got the right list of applicable methods for Bar');
  93
  94
  95 is_deeply(
  96     [ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Baz')->compute_all_applicable_methods() ],
  97     [
  98         {
  99             name  => 'BUILD',
 100             class => 'Baz',
 101             code  => \&Baz::BUILD
 102         },
 103         {
 104             name  => 'bar',
 105             class => 'Bar',
 106             code  => \&Bar::bar
 107         },
 108         {
 109             name  => 'baz',
 110             class => 'Baz',
 111             code  => \&Baz::baz
 112         },
 113         {
 114             name  => 'foo',
 115             class => 'Baz',
 116             code  => \&Baz::foo
 117         },
 118     ],
 119     '... got the right list of applicable methods for Baz');
 120
 121 is_deeply(
 122     [ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Foo::Bar')->compute_all_applicable_methods() ],
 123     [
 124         {
 125             name  => 'BUILD',
 126             class => 'Foo::Bar',
 127             code  => \&Foo::Bar::BUILD
 128         },
 129         {
 130             name  => 'bar',
 131             class => 'Bar',
 132             code  => \&Bar::bar
 133         },
 134         {
 135             name  => 'foo',
 136             class => 'Foo',
 137             code  => \&Foo::foo
 138         },
 139         {
 140             name  => 'foobar',
 141             class => 'Foo::Bar',
 142             code  => \&Foo::Bar::foobar
 143         },
 144     ],
 145     '... got the right list of applicable methods for Foo::Bar');
 146
 147 is_deeply(
 148     [ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Foo::Bar::Baz')->compute_all_applicable_methods() ],
 149     [
 150         {
 151             name  => 'BUILD',
 152             class => 'Foo::Bar::Baz',
 153             code  => \&Foo::Bar::Baz::BUILD
 154         },
 155         {
 156             name  => 'bar',
 157             class => 'Foo::Bar::Baz',
 158             code  => \&Foo::Bar::Baz::bar
 159         },
 160         {
 161             name  => 'baz',
 162             class => 'Baz',
 163             code  => \&Baz::baz
 164         },
 165         {
 166             name  => 'foo',
 167             class => 'Foo',
 168             code  => \&Foo::foo
 169         },
 170         {
 171             name  => 'foobarbaz',
 172             class => 'Foo::Bar::Baz',
 173             code  => \&Foo::Bar::Baz::foobarbaz
 174         },
 175     ],
 176     '... got the right list of applicable methods for Foo::Bar::Baz');
 177
 178 ## find_all_methods_by_name
 179
 180 is_deeply(
 181     [ Class::MOP::Class->initialize('Foo::Bar')->find_all_methods_by_name('BUILD') ],
 182     [
 183         {
 184             name  => 'BUILD',
 185             class => 'Foo::Bar',
 186             code  => \&Foo::Bar::BUILD
 187         },
 188         {
 189             name  => 'BUILD',
 190             class => 'Foo',
 191             code  => \&Foo::BUILD
 192         },
 193         {
 194             name  => 'BUILD',
 195             class => 'Bar',
 196             code  => \&Bar::BUILD
 197         }
 198     ],
 199     '... got the right list of BUILD methods for Foo::Bar');
 200
 201 is_deeply(
 202     [ Class::MOP::Class->initialize('Foo::Bar::Baz')->find_all_methods_by_name('BUILD') ],
 203     [
 204         {
 205             name  => 'BUILD',
 206             class => 'Foo::Bar::Baz',
 207             code  => \&Foo::Bar::Baz::BUILD
 208         },
 209         {
 210             name  => 'BUILD',
 211             class => 'Foo',
 212             code  => \&Foo::BUILD
 213         },
 214         {
 215             name  => 'BUILD',
 216             class => 'Bar',
 217             code  => \&Bar::BUILD
 218         },
 219         {
 220             name  => 'BUILD',
 221             class => 'Baz',
 222             code  => \&Baz::BUILD
 223         },
 224     ],
 225     '... got the right list of BUILD methods for Foo::Bar::Baz');