Commit | Line | Data |
60dfe768 |
1 | #!/usr/bin/env perl |
2 | |
3 | use lib 'lib', 't/role-basic/lib'; |
4 | use MyTests; |
5 | require Role::Tiny::Restricted; |
6 | |
7 | { |
8 | |
9 | package My::Does::Basic1; |
10 | use Role::Tiny::Restricted; |
11 | requires 'turbo_charger'; |
12 | |
13 | sub method { |
14 | return __PACKAGE__ . " method"; |
15 | } |
16 | } |
17 | { |
18 | |
19 | package My::Does::Basic2; |
20 | use Role::Tiny::Restricted; |
21 | requires 'turbo_charger'; |
22 | |
23 | sub method2 { |
24 | return __PACKAGE__ . " method2"; |
25 | } |
26 | } |
27 | |
28 | eval <<'END_PACKAGE'; |
29 | package My::Class1; |
30 | use Role::Tiny::Restricted 'with'; |
31 | with qw( |
32 | My::Does::Basic1 |
33 | My::Does::Basic2 |
34 | ); |
35 | sub turbo_charger {} |
36 | END_PACKAGE |
37 | ok !$@, 'We should be able to use two roles with the same requirements' |
38 | or die $@; |
39 | |
40 | { |
41 | |
42 | package My::Does::Basic3; |
43 | use Role::Tiny::Restricted; |
44 | with 'My::Does::Basic2'; |
45 | |
46 | sub method3 { |
47 | return __PACKAGE__ . " method3"; |
48 | } |
49 | } |
50 | |
51 | eval <<'END_PACKAGE'; |
52 | package My::Class2; |
53 | use Role::Tiny::Restricted 'with'; |
54 | with qw( |
55 | My::Does::Basic3 |
56 | ); |
57 | sub new { bless {} => shift } |
58 | sub turbo_charger {} |
59 | END_PACKAGE |
60 | ok !$@, 'We should be able to use roles which consume roles' |
61 | or die $@; |
62 | can_ok 'My::Class2', 'method2'; |
63 | is My::Class2->method2, 'My::Does::Basic2 method2', |
64 | '... and it should be the correct method'; |
65 | can_ok 'My::Class2', 'method3'; |
66 | is My::Class2->method3, 'My::Does::Basic3 method3', |
67 | '... and it should be the correct method'; |
68 | |
69 | ok My::Class2->Role::Tiny::does_role('My::Does::Basic3'), 'A class DOES roles which it consumes'; |
70 | ok My::Class2->Role::Tiny::does_role('My::Does::Basic2'), |
71 | '... and should do roles which its roles consumes'; |
72 | ok !My::Class2->Role::Tiny::does_role('My::Does::Basic1'), |
73 | '... but not roles which it never consumed'; |
74 | |
75 | my $object = My::Class2->new; |
76 | ok $object->Role::Tiny::does_role('My::Does::Basic3'), 'An instance DOES roles which its class consumes'; |
77 | ok $object->Role::Tiny::does_role('My::Does::Basic2'), |
78 | '... and should do roles which its roles consumes'; |
79 | ok !$object->Role::Tiny::does_role('My::Does::Basic1'), |
80 | '... but not roles which it never consumed'; |
81 | |
82 | { |
83 | { |
84 | package Role::Which::Imports; |
85 | use Role::Tiny::Restricted allow => 'TestMethods'; |
86 | use TestMethods qw(this that); |
87 | } |
88 | { |
89 | package Class::With::ImportingRole; |
90 | use Role::Tiny::Restricted 'with'; |
91 | with 'Role::Which::Imports'; |
92 | sub new { bless {} => shift } |
93 | } |
94 | my $o = Class::With::ImportingRole->new; |
95 | |
96 | foreach my $method (qw/this that/) { |
97 | can_ok $o, $method; |
98 | ok $o->$method($method), '... and calling "allow"ed methods should succeed'; |
99 | is $o->$method, $method, '... and it should function correctly'; |
100 | } |
101 | } |
102 | |
103 | { |
104 | { |
105 | package Role::WithImportsOnceRemoved; |
106 | use Role::Tiny::Restricted; |
107 | with 'Role::Which::Imports'; |
108 | } |
109 | { |
110 | package Class::With::ImportingRole2; |
111 | use Role::Tiny::Restricted 'with'; |
112 | $ENV{DEBUG} = 1; |
113 | with 'Role::WithImportsOnceRemoved'; |
114 | sub new { bless {} => shift } |
115 | } |
116 | ok my $o = Class::With::ImportingRole2->new, |
117 | 'We should be able to use roles which compose roles which import'; |
118 | |
119 | foreach my $method (qw/this that/) { |
120 | can_ok $o, $method; |
121 | ok $o->$method($method), '... and calling "allow"ed methods should succeed'; |
122 | is $o->$method, $method, '... and it should function correctly'; |
123 | } |
124 | } |
125 | |
126 | done_testing; |