Commit | Line | Data |
873df570 |
1 | use strictures 1; |
2 | use Test::More; |
3 | |
4 | BEGIN { |
5 | package Method::Generate::Accessor::Role::ArrayRefInstance; |
6 | |
7 | use Moo::Role; |
8 | |
9 | sub _generate_simple_get { |
10 | my ($self, $me, $name, $spec) = @_; |
11 | "${me}->[${\$spec->{index}}]"; |
12 | } |
13 | |
14 | sub _generate_core_set { |
15 | my ($self, $me, $name, $spec, $value) = @_; |
16 | "${me}->[${\$spec->{index}}] = $value"; |
17 | } |
18 | |
19 | sub _generate_simple_has { |
20 | my ($self, $me, $name, $spec) = @_; |
21 | "defined ${me}->[${\$spec->{index}}]"; |
22 | } |
23 | |
24 | sub _generate_simple_clear { |
25 | my ($self, $me, $name, $spec) = @_; |
26 | "undef(${me}->[${\$spec->{index}}])"; |
27 | } |
28 | |
29 | sub generate_multi_set { |
30 | my ($self, $me, $to_set, $from, $specs) = @_; |
31 | "\@{${me}}[${\join ', ', map $specs->{$_}{index}, @$to_set}] = $from"; |
32 | } |
33 | |
34 | sub _generate_xs { |
35 | my ($self, $type, $into, $name, $slot, $spec) = @_; |
36 | require Class::XSAccessor::Array; |
37 | Class::XSAccessor::Array->import( |
38 | class => $into, |
39 | $type => { $name => $spec->{index} } |
40 | ); |
41 | $into->can($name); |
42 | } |
43 | |
44 | sub default_construction_string { '[]' } |
632a53e0 |
45 | |
46 | sub MooX::ArrayRef::import { |
47 | Moo::Role->apply_roles_to_object( |
48 | Moo->_accessor_maker_for(scalar caller), |
49 | 'Method::Generate::Accessor::Role::ArrayRefInstance' |
50 | ); |
51 | } |
52 | $INC{"MooX/ArrayRef.pm"} = 1; |
873df570 |
53 | } |
54 | |
55 | { |
56 | package ArrayTest1; |
57 | |
58 | use Moo; |
632a53e0 |
59 | use MooX::ArrayRef; |
873df570 |
60 | |
61 | has one => (is => 'ro'); |
62 | has two => (is => 'ro'); |
63 | has three => (is => 'ro'); |
64 | } |
65 | |
66 | my $o = ArrayTest1->new(one => 1, two => 2, three => 3); |
67 | |
68 | is_deeply([ @$o ], [ 1, 2, 3 ], 'Basic object ok'); |
69 | |
70 | { |
71 | package ArrayTest2; |
72 | |
73 | use Moo; |
74 | |
75 | extends 'ArrayTest1'; |
76 | |
77 | has four => (is => 'ro'); |
78 | } |
79 | |
80 | $o = ArrayTest2->new(one => 1, two => 2, three => 3, four => 4); |
81 | |
82 | is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object ok'); |
83 | |
db10ae2d |
84 | { |
85 | package ArrayTestRole; |
86 | |
87 | use Moo::Role; |
88 | |
89 | has four => (is => 'ro'); |
90 | |
91 | package ArrayTest3; |
92 | |
93 | use Moo; |
94 | |
95 | extends 'ArrayTest1'; |
96 | |
97 | with 'ArrayTestRole'; |
98 | } |
99 | |
100 | $o = ArrayTest3->new(one => 1, two => 2, three => 3, four => 4); |
101 | |
102 | is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object w/role'); |
103 | |
873df570 |
104 | done_testing; |