Moose-t-failing/030_roles/032_roles_and_method_cloning.t

   1 #!/usr/bin/perl
   2 # This is automatically generated by author/import-moose-test.pl.
   3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
   4 use t::lib::MooseCompat;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10 $TODO = q{Mouse is not yet completed};
  11
  12
  13 {
  14     package Role::Foo;
  15     use Mouse::Role;
  16
  17     sub foo { (caller(0))[3] }
  18 }
  19
  20 {
  21     package ClassA;
  22     use Mouse;
  23
  24     with 'Role::Foo';
  25 }
  26
  27 {
  28     my $meth = ClassA->meta->get_method('foo');
  29     ok( $meth, 'ClassA has a foo method' );
  30     isa_ok( $meth, 'Mouse::Meta::Method' );
  31     is( $meth->original_method, Role::Foo->meta->get_method('foo'),
  32         'ClassA->foo was cloned from Role::Foo->foo' );
  33     is( $meth->fully_qualified_name, 'ClassA::foo',
  34         'fq name is ClassA::foo' );
  35     is( $meth->original_fully_qualified_name, 'Role::Foo::foo',
  36         'original fq name is Role::Foo::foo' );
  37 }
  38
  39 {
  40     package Role::Bar;
  41     use Mouse::Role;
  42     with 'Role::Foo';
  43
  44     sub bar { }
  45 }
  46
  47 {
  48     my $meth = Role::Bar->meta->get_method('foo');
  49     ok( $meth, 'Role::Bar has a foo method' );
  50     is( $meth->original_method, Role::Foo->meta->get_method('foo'),
  51         'Role::Bar->foo was cloned from Role::Foo->foo' );
  52     is( $meth->fully_qualified_name, 'Role::Bar::foo',
  53         'fq name is Role::Bar::foo' );
  54     is( $meth->original_fully_qualified_name, 'Role::Foo::foo',
  55         'original fq name is Role::Foo::foo' );
  56 }
  57
  58 {
  59     package ClassB;
  60     use Mouse;
  61
  62     with 'Role::Bar';
  63 }
  64
  65 {
  66     my $meth = ClassB->meta->get_method('foo');
  67     ok( $meth, 'ClassB has a foo method' );
  68     is( $meth->original_method, Role::Bar->meta->get_method('foo'),
  69         'ClassA->foo was cloned from Role::Bar->foo' );
  70     is( $meth->original_method->original_method, Role::Foo->meta->get_method('foo'),
  71         '... which in turn was cloned from Role::Foo->foo' );
  72     is( $meth->fully_qualified_name, 'ClassB::foo',
  73         'fq name is ClassA::foo' );
  74     is( $meth->original_fully_qualified_name, 'Role::Foo::foo',
  75         'original fq name is Role::Foo::foo' );
  76 }
  77
  78 isnt( ClassA->foo, "ClassB::foo", "ClassA::foo is not confused with ClassB::foo");
  79
  80 is( ClassB->foo, 'Role::Foo::foo', 'ClassB::foo knows its name' );
  81 is( ClassA->foo, 'Role::Foo::foo', 'ClassA::foo knows its name' );
  82
  83 done_testing;