Commit | Line | Data |
1947330a |
1 | use strictures 1; |
2 | use Test::More; |
75967522 |
3 | use Test::Fatal; |
1947330a |
4 | |
5 | { |
6 | package One; use Role::Tiny; |
7 | around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; |
8 | package Two; use Role::Tiny; |
9 | around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; |
10 | package Three; use Role::Tiny; |
11 | around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; |
12 | package Four; use Role::Tiny; |
13 | around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; |
14 | package Base; sub foo { __PACKAGE__ } |
15 | } |
16 | |
17 | foreach my $combo ( |
18 | [ qw(One Two Three Four) ], |
19 | [ qw(Two Four Three) ], |
20 | [ qw(One Two) ] |
21 | ) { |
22 | my $combined = Role::Tiny->create_class_with_roles('Base', @$combo); |
23 | is_deeply( |
24 | [ $combined->foo ], [ reverse(@$combo), 'Base' ], |
25 | "${combined} ok" |
26 | ); |
27 | my $object = bless({}, 'Base'); |
28 | Role::Tiny->apply_roles_to_object($object, @$combo); |
29 | is(ref($object), $combined, 'Object reblessed into correct class'); |
30 | } |
31 | |
92f126f1 |
32 | { |
33 | package RoleWithAttr; |
34 | use Moo::Role; |
35 | |
e95d3981 |
36 | has attr1 => (is => 'ro', default => -1); |
92f126f1 |
37 | |
38 | package RoleWithAttr2; |
39 | use Moo::Role; |
40 | |
e95d3981 |
41 | has attr2 => (is => 'ro', default => -2); |
92f126f1 |
42 | |
43 | package ClassWithAttr; |
44 | use Moo; |
45 | |
e95d3981 |
46 | has attr3 => (is => 'ro', default => -3); |
92f126f1 |
47 | } |
48 | |
49 | Moo::Role->apply_roles_to_package('ClassWithAttr', 'RoleWithAttr', 'RoleWithAttr2'); |
50 | my $o = ClassWithAttr->new(attr1 => 1, attr2 => 2, attr3 => 3); |
51 | is($o->attr1, 1, 'attribute from role works'); |
52 | is($o->attr2, 2, 'attribute from role 2 works'); |
53 | is($o->attr3, 3, 'attribute from base class works'); |
54 | |
e95d3981 |
55 | { |
56 | package SubClassWithoutAttr; |
57 | use Moo; |
58 | extends 'ClassWithAttr'; |
59 | } |
60 | |
61 | my $o2 = Moo::Role->create_class_with_roles( |
62 | 'SubClassWithoutAttr', 'RoleWithAttr')->new; |
63 | is($o2->attr3, -3, 'constructor includes base class'); |
64 | is($o2->attr2, -2, 'constructor includes role'); |
65 | |
75967522 |
66 | { |
67 | package AccessorExtension; |
68 | use Moo::Role; |
69 | around 'generate_method' => sub { |
70 | my $orig = shift; |
71 | my $me = shift; |
72 | my ($into, $name) = @_; |
73 | $me->$orig(@_); |
74 | no strict 'refs'; |
75 | *{"${into}::_${name}_marker"} = sub { }; |
76 | }; |
77 | } |
78 | |
79 | { |
80 | package RoleWithReq; |
81 | use Moo::Role; |
82 | requires '_attr1_marker'; |
83 | } |
84 | |
85 | is exception { |
4055038d |
86 | package ClassWithExtension; |
75967522 |
87 | use Moo; |
88 | Moo::Role->apply_roles_to_object( |
89 | Moo->_accessor_maker_for(__PACKAGE__), |
90 | 'AccessorExtension'); |
91 | |
92 | with qw(RoleWithAttr RoleWithReq); |
93 | }, undef, 'apply_roles_to_object correctly calls accessor generator'; |
94 | |
4055038d |
95 | { |
96 | package EmptyClass; |
97 | use Moo; |
98 | } |
99 | |
100 | { |
101 | package RoleWithReq2; |
102 | use Moo::Role; |
103 | requires 'attr2'; |
104 | } |
105 | |
106 | is exception { |
107 | Moo::Role->create_class_with_roles( |
108 | 'EmptyClass', 'RoleWithReq2', 'RoleWithAttr2'); |
109 | }, undef, 'create_class_with_roles accepts attributes for requirements'; |
110 | |
111 | like exception { |
112 | Moo::Role->create_class_with_roles( |
113 | 'EmptyClass', 'RoleWithReq2', 'RoleWithAttr'); |
114 | }, qr/Can't apply .* missing attr2/, |
115 | 'create_class_with_roles accepts attributes for requirements'; |
116 | |
117 | |
1947330a |
118 | done_testing; |