X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F002_class_precedence_list.t;h=2abfeb79d61e1ab4f4b75a18d4b2f9e4d23086e8;hb=7202116b012d65b1c71d42819a0d2aa2ec5d3bd1;hp=686327b569a61258ad0a6c932b674032281c2060;hpb=bfe4d0fc35c0b24b568cf6a0b4620a0df2aed649;p=gitmo%2FClass-MOP.git diff --git a/t/002_class_precedence_list.t b/t/002_class_precedence_list.t index 686327b..2abfeb7 100644 --- a/t/002_class_precedence_list.t +++ b/t/002_class_precedence_list.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 1; +use Test::More tests => 8; BEGIN { use_ok('Class::MOP'); @@ -22,6 +22,7 @@ B C { package My::A; + use metaclass; package My::B; our @ISA = ('My::A'); package My::C; @@ -31,10 +32,15 @@ B C } is_deeply( - [ Class::MOP::Class->initialize('My::D')->class_precedence_list ], + [ My::D->meta->class_precedence_list ], [ 'My::D', 'My::B', 'My::A', 'My::C', 'My::A' ], '... My::D->meta->class_precedence_list == (D B A C A)'); +is_deeply( + [ My::D->meta->linearized_isa ], + [ 'My::D', 'My::B', 'My::A', 'My::C' ], + '... My::D->meta->linearized_isa == (D B A C)'); + =pod A <-+ @@ -45,18 +51,24 @@ is_deeply( =cut -{ - package My::2::A; - our @ISA = ('My::2::C'); +# 5.9.5+ dies at the moment of +# recursive @ISA definition, not later when +# you try to use the @ISAs. +eval { + { + package My::2::A; + use metaclass; + our @ISA = ('My::2::C'); - package My::2::B; - our @ISA = ('My::2::A'); + package My::2::B; + our @ISA = ('My::2::A'); - package My::2::C; - our @ISA = ('My::2::B'); -} + package My::2::C; + our @ISA = ('My::2::B'); + } -eval { Class::MOP::Class->initialize('My::2::B')->class_precedence_list }; + My::2::B->meta->class_precedence_list +}; ok($@, '... recursive inheritance breaks correctly :)'); =pod @@ -72,6 +84,7 @@ ok($@, '... recursive inheritance breaks correctly :)'); { package My::3::A; + use metaclass; package My::3::B; our @ISA = ('My::3::A'); package My::3::C; @@ -81,6 +94,70 @@ ok($@, '... recursive inheritance breaks correctly :)'); } is_deeply( - [ Class::MOP::Class->initialize('My::3::D')->class_precedence_list ], + [ My::3::D->meta->class_precedence_list ], [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C', 'My::3::A', 'My::3::B', 'My::3::A' ], '... My::3::D->meta->class_precedence_list == (D B A C A B A)'); + +is_deeply( + [ My::3::D->meta->linearized_isa ], + [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C' ], + '... My::3::D->meta->linearized_isa == (D B A C B)'); + +=pod + +Test all the class_precedence_lists +using Perl's own dispatcher to check +against. + +=cut + +my @CLASS_PRECEDENCE_LIST; + +{ + package Foo; + use metaclass; + + sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo' } + + package Bar; + our @ISA = ('Foo'); + + sub CPL { + push @CLASS_PRECEDENCE_LIST => 'Bar'; + $_[0]->SUPER::CPL(); + } + + package Baz; + use metaclass; + our @ISA = ('Bar'); + + sub CPL { + push @CLASS_PRECEDENCE_LIST => 'Baz'; + $_[0]->SUPER::CPL(); + } + + package Foo::Bar; + our @ISA = ('Baz'); + + sub CPL { + push @CLASS_PRECEDENCE_LIST => 'Foo::Bar'; + $_[0]->SUPER::CPL(); + } + + package Foo::Bar::Baz; + our @ISA = ('Foo::Bar'); + + sub CPL { + push @CLASS_PRECEDENCE_LIST => 'Foo::Bar::Baz'; + $_[0]->SUPER::CPL(); + } + +} + +Foo::Bar::Baz->CPL(); + +is_deeply( + [ Foo::Bar::Baz->meta->class_precedence_list ], + [ @CLASS_PRECEDENCE_LIST ], + '... Foo::Bar::Baz->meta->class_precedence_list == @CLASS_PRECEDENCE_LIST'); +