Commit | Line | Data |
67199842 |
1 | #!/usr/bin/perl |
fde8e43f |
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; |
67199842 |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
fde8e43f |
9 | use Test::More; |
10 | $TODO = q{Mouse is not yet completed}; |
67199842 |
11 | |
12 | |
13 | { |
14 | package Role::Foo; |
15 | use Mouse::Role; |
16 | |
6cfa1e5e |
17 | sub foo { (caller(0))[3] } |
67199842 |
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 | } |
6cfa1e5e |
77 | |
78 | isnt( ClassA->foo, "ClassB::foo", "ClassA::foo is not confused with ClassB::foo"); |
79 | |
fde8e43f |
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; |