Commit | Line | Data |
7a50b450 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6475f69d |
6 | use Test::More; |
7a50b450 |
7 | use Test::Exception; |
8 | |
9 | |
7a50b450 |
10 | { |
11 | |
12 | package Foo::Role; |
13 | use Mouse::Role; |
14 | |
15 | requires 'foo'; |
16 | } |
17 | |
18 | is_deeply( |
19 | [ sort Foo::Role->meta->get_required_method_list ], |
20 | ['foo'], |
21 | '... the Foo::Role has a required method (foo)' |
22 | ); |
23 | |
24 | # classes which does not implement required method |
25 | { |
26 | |
27 | package Foo::Class; |
28 | use Mouse; |
29 | |
30 | ::dies_ok { with('Foo::Role') } |
31 | '... no foo method implemented by Foo::Class'; |
32 | } |
33 | |
34 | # class which does implement required method |
35 | { |
36 | |
37 | package Bar::Class; |
38 | use Mouse; |
39 | |
40 | ::dies_ok { with('Foo::Class') } |
41 | '... cannot consume a class, it must be a role'; |
42 | ::lives_ok { with('Foo::Role') } |
43 | '... has a foo method implemented by Bar::Class'; |
44 | |
45 | sub foo {'Bar::Class::foo'} |
46 | } |
47 | |
48 | # role which does implement required method |
49 | { |
50 | |
51 | package Bar::Role; |
52 | use Mouse::Role; |
53 | |
54 | ::lives_ok { with('Foo::Role') } |
55 | '... has a foo method implemented by Bar::Role'; |
56 | |
57 | sub foo {'Bar::Role::foo'} |
58 | } |
59 | |
60 | is_deeply( |
61 | [ sort Bar::Role->meta->get_required_method_list ], |
62 | [], |
63 | '... the Bar::Role has not inherited the required method from Foo::Role' |
64 | ); |
65 | |
66 | # role which does not implement required method |
67 | { |
68 | |
69 | package Baz::Role; |
70 | use Mouse::Role; |
71 | |
72 | ::lives_ok { with('Foo::Role') } |
73 | '... no foo method implemented by Baz::Role'; |
74 | } |
75 | |
76 | is_deeply( |
77 | [ sort Baz::Role->meta->get_required_method_list ], |
78 | ['foo'], |
79 | '... the Baz::Role has inherited the required method from Foo::Role' |
80 | ); |
81 | |
82 | # classes which does not implement required method |
83 | { |
84 | |
85 | package Baz::Class; |
86 | use Mouse; |
87 | |
88 | ::dies_ok { with('Baz::Role') } |
89 | '... no foo method implemented by Baz::Class2'; |
90 | } |
91 | |
92 | # class which does implement required method |
93 | { |
94 | |
95 | package Baz::Class2; |
96 | use Mouse; |
97 | |
98 | ::lives_ok { with('Baz::Role') } |
99 | '... has a foo method implemented by Baz::Class2'; |
100 | |
101 | sub foo {'Baz::Class2::foo'} |
102 | } |
103 | |
104 | |
105 | { |
106 | package Quux::Role; |
107 | use Mouse::Role; |
108 | |
109 | requires qw( meth1 meth2 meth3 meth4 ); |
110 | } |
111 | |
112 | # RT #41119 |
113 | { |
114 | |
115 | package Quux::Class; |
116 | use Mouse; |
117 | |
118 | ::throws_ok { with('Quux::Role') } |
119 | qr/\Q'Quux::Role' requires the methods 'meth1', 'meth2', 'meth3', and 'meth4' to be implemented by 'Quux::Class'/, |
120 | 'exception mentions all the missing required methods at once'; |
121 | } |
122 | |
123 | { |
124 | package Quux::Class2; |
125 | use Mouse; |
126 | |
127 | sub meth1 { } |
128 | |
129 | ::throws_ok { with('Quux::Role') } |
130 | qr/'Quux::Role' requires the methods 'meth2', 'meth3', and 'meth4' to be implemented by 'Quux::Class2'/, |
131 | 'exception mentions all the missing required methods at once, but not the one that exists'; |
132 | } |
133 | |
134 | { |
135 | package Quux::Class3; |
136 | use Mouse; |
137 | |
138 | has 'meth1' => ( is => 'ro' ); |
139 | has 'meth2' => ( is => 'ro' ); |
140 | |
141 | ::throws_ok { with('Quux::Role') } |
142 | qr/'Quux::Role' requires the methods 'meth3' and 'meth4' to be implemented by 'Quux::Class3'/, |
143 | 'exception mentions all the missing methods at once, but not the accessors'; |
144 | } |
145 | |
146 | { |
147 | package Quux::Class4; |
148 | use Mouse; |
149 | |
150 | sub meth1 { } |
151 | has 'meth2' => ( is => 'ro' ); |
152 | |
153 | ::throws_ok { with('Quux::Role') } |
154 | qr/'Quux::Role' requires the methods 'meth3' and 'meth4' to be implemented by 'Quux::Class4'/, |
155 | 'exception mentions all the require methods that are accessors at once, as well as missing methods, but not the one that exists'; |
156 | } |
6475f69d |
157 | |
158 | done_testing; |