Commit | Line | Data |
1947330a |
1 | use strictures 1; |
2 | use Test::More; |
3 | |
4 | { |
5 | package One; use Role::Tiny; |
6 | around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; |
7 | package Two; use Role::Tiny; |
8 | around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; |
9 | package Three; use Role::Tiny; |
10 | around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; |
11 | package Four; use Role::Tiny; |
12 | around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; |
13 | package Base; sub foo { __PACKAGE__ } |
14 | } |
15 | |
16 | foreach my $combo ( |
17 | [ qw(One Two Three Four) ], |
18 | [ qw(Two Four Three) ], |
19 | [ qw(One Two) ] |
20 | ) { |
21 | my $combined = Role::Tiny->create_class_with_roles('Base', @$combo); |
22 | is_deeply( |
23 | [ $combined->foo ], [ reverse(@$combo), 'Base' ], |
24 | "${combined} ok" |
25 | ); |
26 | my $object = bless({}, 'Base'); |
27 | Role::Tiny->apply_roles_to_object($object, @$combo); |
28 | is(ref($object), $combined, 'Object reblessed into correct class'); |
29 | } |
30 | |
92f126f1 |
31 | { |
32 | package RoleWithAttr; |
33 | use Moo::Role; |
34 | |
e95d3981 |
35 | has attr1 => (is => 'ro', default => -1); |
92f126f1 |
36 | |
37 | package RoleWithAttr2; |
38 | use Moo::Role; |
39 | |
e95d3981 |
40 | has attr2 => (is => 'ro', default => -2); |
92f126f1 |
41 | |
42 | package ClassWithAttr; |
43 | use Moo; |
44 | |
e95d3981 |
45 | has attr3 => (is => 'ro', default => -3); |
92f126f1 |
46 | } |
47 | |
48 | Moo::Role->apply_roles_to_package('ClassWithAttr', 'RoleWithAttr', 'RoleWithAttr2'); |
49 | my $o = ClassWithAttr->new(attr1 => 1, attr2 => 2, attr3 => 3); |
50 | is($o->attr1, 1, 'attribute from role works'); |
51 | is($o->attr2, 2, 'attribute from role 2 works'); |
52 | is($o->attr3, 3, 'attribute from base class works'); |
53 | |
e95d3981 |
54 | { |
55 | package SubClassWithoutAttr; |
56 | use Moo; |
57 | extends 'ClassWithAttr'; |
58 | } |
59 | |
60 | my $o2 = Moo::Role->create_class_with_roles( |
61 | 'SubClassWithoutAttr', 'RoleWithAttr')->new; |
62 | is($o2->attr3, -3, 'constructor includes base class'); |
63 | is($o2->attr2, -2, 'constructor includes role'); |
64 | |
1947330a |
65 | done_testing; |