X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=t%2F030_roles%2Ffailing%2F032_roles_and_method_cloning.t;fp=t%2F030_roles%2Ffailing%2F032_roles_and_method_cloning.t;h=0000000000000000000000000000000000000000;hp=2b4e615767f1525c3d421bf6fd837aed2057fc9a;hb=c47cf41554416ee1828eab17d31342a53aaa0839;hpb=9864f0e4ba233c5f30ad6dc7c484ced43d883d27 diff --git a/t/030_roles/failing/032_roles_and_method_cloning.t b/t/030_roles/failing/032_roles_and_method_cloning.t deleted file mode 100644 index 2b4e615..0000000 --- a/t/030_roles/failing/032_roles_and_method_cloning.t +++ /dev/null @@ -1,81 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 17; - - -{ - package Role::Foo; - use Mouse::Role; - - sub foo { (caller(0))[3] } -} - -{ - package ClassA; - use Mouse; - - with 'Role::Foo'; -} - -{ - my $meth = ClassA->meta->get_method('foo'); - ok( $meth, 'ClassA has a foo method' ); - isa_ok( $meth, 'Mouse::Meta::Method' ); - is( $meth->original_method, Role::Foo->meta->get_method('foo'), - 'ClassA->foo was cloned from Role::Foo->foo' ); - is( $meth->fully_qualified_name, 'ClassA::foo', - 'fq name is ClassA::foo' ); - is( $meth->original_fully_qualified_name, 'Role::Foo::foo', - 'original fq name is Role::Foo::foo' ); -} - -{ - package Role::Bar; - use Mouse::Role; - with 'Role::Foo'; - - sub bar { } -} - -{ - my $meth = Role::Bar->meta->get_method('foo'); - ok( $meth, 'Role::Bar has a foo method' ); - is( $meth->original_method, Role::Foo->meta->get_method('foo'), - 'Role::Bar->foo was cloned from Role::Foo->foo' ); - is( $meth->fully_qualified_name, 'Role::Bar::foo', - 'fq name is Role::Bar::foo' ); - is( $meth->original_fully_qualified_name, 'Role::Foo::foo', - 'original fq name is Role::Foo::foo' ); -} - -{ - package ClassB; - use Mouse; - - with 'Role::Bar'; -} - -{ - my $meth = ClassB->meta->get_method('foo'); - ok( $meth, 'ClassB has a foo method' ); - is( $meth->original_method, Role::Bar->meta->get_method('foo'), - 'ClassA->foo was cloned from Role::Bar->foo' ); - is( $meth->original_method->original_method, Role::Foo->meta->get_method('foo'), - '... which in turn was cloned from Role::Foo->foo' ); - is( $meth->fully_qualified_name, 'ClassB::foo', - 'fq name is ClassA::foo' ); - is( $meth->original_fully_qualified_name, 'Role::Foo::foo', - 'original fq name is Role::Foo::foo' ); -} - -isnt( ClassA->foo, "ClassB::foo", "ClassA::foo is not confused with ClassB::foo"); - -{ - local $TODO = - "multiply-consumed roles' subs take on their most recently used name"; - is( ClassB->foo, 'ClassB::foo', 'ClassB::foo knows its name' ); - is( ClassA->foo, 'ClassA::foo', 'ClassA::foo knows its name' ); -}