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 | |
48 | SharedTests::run_tests('ClassWithRoleHCA'); |
49 | |
50 | # These next tests are aimed at testing to-role application followed by |
51 | # to-class application |
52 | { |
53 | package RoleWithRoleHCA; |
54 | |
55 | use Moose::Role; |
56 | use MooseX::ClassAttribute; |
57 | |
58 | with 'RoleHCA'; |
59 | } |
60 | |
61 | { |
62 | package ClassWithRoleWithRoleHCA; |
63 | |
64 | use Moose; |
65 | |
66 | with 'RoleWithRoleHCA'; |
67 | |
68 | has 'size' => ( |
69 | is => 'rw', |
70 | isa => 'Int', |
71 | default => 5, |
72 | ); |
73 | |
74 | sub BUILD { |
75 | my $self = shift; |
76 | |
77 | $self->ObjectCount( $self->ObjectCount() + 1 ); |
78 | } |
79 | |
80 | sub _BuildIt {42} |
81 | |
82 | sub _CallTrigger { |
83 | push @{ $_[0]->TriggerRecord() }, [@_]; |
84 | } |
85 | } |
86 | |
87 | SharedTests::run_tests('ClassWithRoleWithRoleHCA'); |
88 | |
89 | { |
90 | package InstanceWithRoleHCA; |
91 | |
92 | use Moose; |
93 | |
94 | has 'size' => ( |
95 | is => 'rw', |
96 | isa => 'Int', |
97 | default => 5, |
98 | ); |
99 | |
100 | sub _BuildIt {42} |
101 | |
102 | sub _CallTrigger { |
103 | push @{ $_[0]->TriggerRecord() }, [@_]; |
104 | } |
105 | } |
106 | |
107 | my $instance = InstanceWithRoleHCA->new(); |
108 | |
109 | apply_all_roles( $instance, 'RoleHCA' ); |
110 | |
111 | $instance->ObjectCount(1); |
112 | |
113 | SharedTests::run_tests($instance); |
114 | |
115 | done_testing(); |