1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
use strict;
use warnings;
use Test::More;
BEGIN {
package MyRole;
use Role::Tiny;
requires qw(req1 req2);
sub bar { 'role bar' }
sub baz { 'role baz' }
}
BEGIN {
package MyClass;
use constant SIMPLE => 'simple';
use constant REF_CONST => [ 'ref_const' ];
use constant VSTRING_CONST => v1;
sub req1 { }
sub req2 { }
sub foo { 'class foo' }
sub baz { 'class baz' }
}
BEGIN {
package ExtraClass;
sub req1 { }
sub req2 { }
sub req3 { }
sub foo { }
sub baz { 'class baz' }
}
BEGIN {
package IntermediaryRole;
use Role::Tiny;
requires 'req3';
}
BEGIN {
package NoMethods;
package OneMethod;
sub req1 { }
}
BEGIN {
package ExtraRole;
use Role::Tiny;
sub extra1 { 'role extra' }
}
sub try_apply_to {
my $to = shift;
eval { Role::Tiny->apply_role_to_package($to, 'MyRole'); 1 }
and return undef;
return $@ if $@;
die "false exception caught!";
}
is(try_apply_to('MyClass'), undef, 'role applies cleanly');
is(MyClass->bar, 'role bar', 'method from role');
is(MyClass->baz, 'class baz', 'method from class');
ok(MyClass->does('MyRole'), 'class does role');
ok(!MyClass->does('IntermediaryRole'), 'class does not do non-applied role');
ok(!MyClass->does('Random'), 'class does not do non-role');
like try_apply_to(bless {}, 'MyClass'), qr/\ACan't apply roles to object/,
'error apply_role_to_package on object';
like(try_apply_to('NoMethods'), qr/req1, req2/, 'error for both methods');
like(try_apply_to('OneMethod'), qr/req2/, 'error for one method');
eval {
Role::Tiny->apply_role_to_package('IntermediaryRole', 'MyRole');
Role::Tiny->apply_role_to_package('ExtraClass', 'IntermediaryRole');
1;
} or $@ ||= "false exception!";
is $@, '', 'No errors applying roles';
eval {
Role::Tiny->apply_role_to_package('MyClass', 'ExtraClass');
};
like $@, qr/ExtraClass is not a Role::Tiny/, 'No errors applying roles';
ok(ExtraClass->does('MyRole'), 'ExtraClass does MyRole');
ok(ExtraClass->does('IntermediaryRole'), 'ExtraClass does IntermediaryRole');
is(ExtraClass->bar, 'role bar', 'method from role');
is(ExtraClass->baz, 'class baz', 'method from class');
my $new_class;
eval {
$new_class = Role::Tiny->create_class_with_roles('MyClass', 'ExtraRole');
} or $@ ||= "false exception!";
is $@, '', 'No errors creating class with roles';
isa_ok($new_class, 'MyClass');
is($new_class->extra1, 'role extra', 'method from role');
eval {
Role::Tiny->create_class_with_roles('MyClass');
1;
} or $@ ||= "false exception!";
like $@, qr/^No roles supplied!/,
'error on no roles to create_class_with_roles';
eval {
Role::Tiny->create_class_with_roles('MyClass', 'ExtraClass');
1;
} or $@ ||= "false exception!";
like $@, qr/^ExtraClass is not a Role::Tiny/,
'error on non-role to create_class_with_roles';
ok(Role::Tiny->is_role('MyRole'), 'is_role true for roles');
ok(!Role::Tiny->is_role('MyClass'), 'is_role false for classes');
done_testing;
|
