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 | |
41 | sub _BuildIt {42} |
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 | |
62 | |
88b7f2c8 |
63 | # These next tests are aimed at testing to-role application followed by |
64 | # to-class application |
65 | { |
66 | package RoleWithRoleHCA; |
67 | |
68 | use Moose::Role; |
69 | use MooseX::ClassAttribute; |
70 | |
71 | with 'RoleHCA'; |
72 | } |
73 | |
fb949f72 |
74 | ok( |
75 | RoleWithRoleHCA->meta()->does_role('RoleHCA'), |
76 | 'RoleWithRoleHCA does RoleHCA' |
77 | ); |
78 | |
88b7f2c8 |
79 | { |
80 | package ClassWithRoleWithRoleHCA; |
81 | |
82 | use Moose; |
83 | |
84 | with 'RoleWithRoleHCA'; |
85 | |
86 | has 'size' => ( |
87 | is => 'rw', |
88 | isa => 'Int', |
89 | default => 5, |
90 | ); |
91 | |
92 | sub BUILD { |
93 | my $self = shift; |
94 | |
95 | $self->ObjectCount( $self->ObjectCount() + 1 ); |
96 | } |
97 | |
98 | sub _BuildIt {42} |
99 | |
100 | sub _CallTrigger { |
101 | push @{ $_[0]->TriggerRecord() }, [@_]; |
102 | } |
103 | } |
104 | |
fb949f72 |
105 | ok( |
106 | ClassWithRoleWithRoleHCA->meta()->does_role('RoleHCA'), |
26fcf891 |
107 | 'ClassWithRoleWithRoleHCA does RoleHCA' |
108 | ); |
109 | |
88b7f2c8 |
110 | SharedTests::run_tests('ClassWithRoleWithRoleHCA'); |
111 | |
26fcf891 |
112 | ClassWithRoleWithRoleHCA->meta()->make_immutable(); |
113 | |
fb949f72 |
114 | ok( |
115 | ClassWithRoleWithRoleHCA->meta()->does_role('RoleHCA'), |
26fcf891 |
116 | 'ClassWithRoleWithRoleHCA (immutable) does RoleHCA' |
117 | ); |
118 | |
88b7f2c8 |
119 | { |
120 | package InstanceWithRoleHCA; |
121 | |
122 | use Moose; |
123 | |
124 | has 'size' => ( |
125 | is => 'rw', |
126 | isa => 'Int', |
127 | default => 5, |
128 | ); |
129 | |
130 | sub _BuildIt {42} |
131 | |
132 | sub _CallTrigger { |
133 | push @{ $_[0]->TriggerRecord() }, [@_]; |
134 | } |
135 | } |
136 | |
137 | my $instance = InstanceWithRoleHCA->new(); |
138 | |
139 | apply_all_roles( $instance, 'RoleHCA' ); |
140 | |
fb949f72 |
141 | ok( |
142 | $instance->meta()->does_role('RoleHCA'), |
26fcf891 |
143 | '$instance does RoleHCA' |
144 | ); |
145 | |
88b7f2c8 |
146 | $instance->ObjectCount(1); |
147 | |
148 | SharedTests::run_tests($instance); |
149 | |
26fcf891 |
150 | $instance->meta()->make_immutable(); |
151 | |
fb949f72 |
152 | ok( |
153 | $instance->meta()->does_role('RoleHCA'), |
26fcf891 |
154 | '$instance (immutable) does RoleHCA' |
155 | ); |
156 | |
88b7f2c8 |
157 | done_testing(); |