Commit | Line | Data |
88b7f2c8 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use lib 't/lib'; |
5 | |
6 | use SharedTests; |
7 | use Test::More; |
8 | |
9 | use Moose::Util qw( apply_all_roles ); |
10 | |
11 | { |
12 | package RoleHCA; |
13 | |
14 | use Moose::Role; |
15 | use MooseX::ClassAttribute; |
16 | |
17 | while ( my ( $name, $def ) = each %SharedTests::Attrs ) { |
18 | class_has $name => %{$def}; |
19 | } |
20 | } |
21 | |
22 | { |
23 | package ClassWithRoleHCA; |
24 | |
25 | use Moose; |
26 | |
27 | with 'RoleHCA'; |
28 | |
29 | has 'size' => ( |
30 | is => 'rw', |
31 | isa => 'Int', |
32 | default => 5, |
33 | ); |
34 | |
35 | sub BUILD { |
36 | my $self = shift; |
37 | |
38 | $self->ObjectCount( $self->ObjectCount() + 1 ); |
39 | } |
40 | |
3e9e5aef |
41 | sub _BuildIt { 42 } |
88b7f2c8 |
42 | |
43 | sub _CallTrigger { |
44 | push @{ $_[0]->TriggerRecord() }, [@_]; |
45 | } |
46 | } |
47 | |
fb949f72 |
48 | ok( |
49 | ClassWithRoleHCA->meta()->does_role('RoleHCA'), |
26fcf891 |
50 | 'ClassWithRoleHCA does RoleHCA' |
51 | ); |
52 | |
88b7f2c8 |
53 | SharedTests::run_tests('ClassWithRoleHCA'); |
54 | |
26fcf891 |
55 | ClassWithRoleHCA->meta()->make_immutable(); |
56 | |
fb949f72 |
57 | ok( |
58 | ClassWithRoleHCA->meta()->does_role('RoleHCA'), |
26fcf891 |
59 | 'ClassWithRoleHCA (immutable) does RoleHCA' |
60 | ); |
61 | |
88b7f2c8 |
62 | # These next tests are aimed at testing to-role application followed by |
63 | # to-class application |
64 | { |
65 | package RoleWithRoleHCA; |
66 | |
67 | use Moose::Role; |
68 | use MooseX::ClassAttribute; |
69 | |
70 | with 'RoleHCA'; |
71 | } |
72 | |
fb949f72 |
73 | ok( |
74 | RoleWithRoleHCA->meta()->does_role('RoleHCA'), |
75 | 'RoleWithRoleHCA does RoleHCA' |
76 | ); |
77 | |
88b7f2c8 |
78 | { |
79 | package ClassWithRoleWithRoleHCA; |
80 | |
81 | use Moose; |
82 | |
83 | with 'RoleWithRoleHCA'; |
84 | |
85 | has 'size' => ( |
86 | is => 'rw', |
87 | isa => 'Int', |
88 | default => 5, |
89 | ); |
90 | |
91 | sub BUILD { |
92 | my $self = shift; |
93 | |
94 | $self->ObjectCount( $self->ObjectCount() + 1 ); |
95 | } |
96 | |
3e9e5aef |
97 | sub _BuildIt { 42 } |
88b7f2c8 |
98 | |
99 | sub _CallTrigger { |
100 | push @{ $_[0]->TriggerRecord() }, [@_]; |
101 | } |
102 | } |
103 | |
fb949f72 |
104 | ok( |
105 | ClassWithRoleWithRoleHCA->meta()->does_role('RoleHCA'), |
26fcf891 |
106 | 'ClassWithRoleWithRoleHCA does RoleHCA' |
107 | ); |
108 | |
88b7f2c8 |
109 | SharedTests::run_tests('ClassWithRoleWithRoleHCA'); |
110 | |
26fcf891 |
111 | ClassWithRoleWithRoleHCA->meta()->make_immutable(); |
112 | |
fb949f72 |
113 | ok( |
114 | ClassWithRoleWithRoleHCA->meta()->does_role('RoleHCA'), |
26fcf891 |
115 | 'ClassWithRoleWithRoleHCA (immutable) does RoleHCA' |
116 | ); |
117 | |
88b7f2c8 |
118 | { |
119 | package InstanceWithRoleHCA; |
120 | |
121 | use Moose; |
122 | |
123 | has 'size' => ( |
124 | is => 'rw', |
125 | isa => 'Int', |
126 | default => 5, |
127 | ); |
128 | |
3e9e5aef |
129 | sub _BuildIt { 42 } |
88b7f2c8 |
130 | |
131 | sub _CallTrigger { |
132 | push @{ $_[0]->TriggerRecord() }, [@_]; |
133 | } |
134 | } |
135 | |
136 | my $instance = InstanceWithRoleHCA->new(); |
137 | |
138 | apply_all_roles( $instance, 'RoleHCA' ); |
139 | |
fb949f72 |
140 | ok( |
141 | $instance->meta()->does_role('RoleHCA'), |
26fcf891 |
142 | '$instance does RoleHCA' |
143 | ); |
144 | |
88b7f2c8 |
145 | $instance->ObjectCount(1); |
146 | |
147 | SharedTests::run_tests($instance); |
148 | |
26fcf891 |
149 | $instance->meta()->make_immutable(); |
150 | |
fb949f72 |
151 | ok( |
152 | $instance->meta()->does_role('RoleHCA'), |
26fcf891 |
153 | '$instance (immutable) does RoleHCA' |
154 | ); |
155 | |
88b7f2c8 |
156 | done_testing(); |