Commit | Line | Data |
41888e7d |
1 | #!/usr/bin/perl |
c47cf415 |
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; |
41888e7d |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
c47cf415 |
9 | use Test::More; |
10 | $TODO = q{Mouse is not yet completed}; |
41888e7d |
11 | |
12 | use Mouse::Util::MetaRole; |
13 | |
14 | BEGIN |
15 | { |
16 | package My::Meta::Class; |
17 | use Mouse; |
18 | extends 'Mouse::Meta::Class'; |
19 | } |
20 | |
21 | BEGIN |
22 | { |
23 | package My::Meta::Attribute; |
24 | use Mouse; |
25 | extends 'Mouse::Meta::Attribute'; |
26 | } |
27 | |
28 | BEGIN |
29 | { |
30 | package My::Meta::Method; |
31 | use Mouse; |
32 | extends 'Mouse::Meta::Method'; |
33 | } |
34 | |
35 | BEGIN |
36 | { |
37 | package My::Meta::Instance; |
38 | use Mouse; |
39 | extends 'Mouse::Meta::Instance'; |
40 | } |
41 | |
42 | BEGIN |
43 | { |
44 | package Role::Foo; |
45 | use Mouse::Role; |
46 | has 'foo' => ( is => 'ro', default => 10 ); |
47 | } |
48 | |
49 | { |
50 | package My::Class; |
51 | |
52 | use metaclass 'My::Meta::Class'; |
53 | use Mouse; |
54 | } |
55 | |
56 | { |
57 | package My::Class2; |
58 | |
59 | use metaclass 'My::Meta::Class' => ( |
60 | attribute_metaclass => 'My::Meta::Attribute', |
61 | method_metaclass => 'My::Meta::Method', |
62 | instance_metaclass => 'My::Meta::Instance', |
63 | ); |
64 | |
65 | use Mouse; |
66 | } |
67 | |
68 | { |
c47cf415 |
69 | Mouse::Util::MetaRole::apply_metaroles( |
70 | for => 'My::Class', |
71 | class_metaroles => { class => ['Role::Foo'] }, |
41888e7d |
72 | ); |
73 | |
74 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
75 | 'apply Role::Foo to My::Class->meta()' ); |
76 | has_superclass( My::Class->meta(), 'My::Meta::Class', |
c47cf415 |
77 | 'apply_metaroles works with metaclass.pm' ); |
41888e7d |
78 | } |
79 | |
80 | { |
c47cf415 |
81 | Mouse::Util::MetaRole::apply_metaroles( |
82 | for => 'My::Class2', |
83 | class_metaroles => { |
84 | attribute => ['Role::Foo'], |
85 | method => ['Role::Foo'], |
86 | instance => ['Role::Foo'], |
87 | }, |
41888e7d |
88 | ); |
89 | |
90 | ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
91 | q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} ); |
92 | has_superclass( My::Class2->meta()->attribute_metaclass(), 'My::Meta::Attribute', |
93 | '... and this does not interfere with attribute metaclass set via metaclass.pm' ); |
94 | ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
95 | q{apply Role::Foo to My::Class2->meta()'s method metaclass} ); |
96 | has_superclass( My::Class2->meta()->method_metaclass(), 'My::Meta::Method', |
97 | '... and this does not interfere with method metaclass set via metaclass.pm' ); |
98 | ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
99 | q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); |
100 | has_superclass( My::Class2->meta()->instance_metaclass(), 'My::Meta::Instance', |
101 | '... and this does not interfere with instance metaclass set via metaclass.pm' ); |
102 | } |
103 | |
104 | # like isa_ok but works with a class name, not just refs |
105 | sub has_superclass { |
106 | my $thing = shift; |
107 | my $parent = shift; |
108 | my $desc = shift; |
109 | |
110 | my %supers = map { $_ => 1 } $thing->meta()->superclasses(); |
111 | |
112 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
113 | |
114 | ok( $supers{$parent}, $desc ); |
115 | } |
c47cf415 |
116 | |
117 | done_testing; |