Regenerate test files
[gitmo/Mouse.git] / t-failing / 030_roles / 032_roles_and_method_cloning.t
CommitLineData
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!!!
4use t::lib::MooseCompat;
67199842 5
6use strict;
7use warnings;
8
fde8e43f 9use 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
78isnt( ClassA->foo, "ClassB::foo", "ClassA::foo is not confused with ClassB::foo");
79
fde8e43f 80is( ClassB->foo, 'Role::Foo::foo', 'ClassB::foo knows its name' );
81is( ClassA->foo, 'Role::Foo::foo', 'ClassA::foo knows its name' );
82
83done_testing;