Commit | Line | Data |
0cfc2850 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
b10dde3a |
5 | use Test::Fatal; |
0cfc2850 |
6 | use Test::Moose; |
7 | |
8 | { |
9 | package ValueContainer; |
10 | use Moose; |
11 | |
12 | has value => ( |
13 | is => 'rw', |
14 | ); |
15 | } |
16 | |
17 | { |
18 | package Foo::Meta::Instance; |
19 | use Moose::Role; |
20 | |
21 | around get_slot_value => sub { |
22 | my $orig = shift; |
23 | my $self = shift; |
24 | my ($instance, $slot_name) = @_; |
25 | my $value = $self->$orig(@_); |
26 | if ($value->isa('ValueContainer')) { |
27 | $value = $value->value; |
28 | } |
29 | return $value; |
30 | }; |
31 | |
32 | around inline_get_slot_value => sub { |
33 | my $orig = shift; |
34 | my $self = shift; |
35 | my $value = $self->$orig(@_); |
36 | return q[do {] . "\n" |
37 | . q[ my $value = ] . $value . q[;] . "\n" |
38 | . q[ if ($value->isa('ValueContainer')) {] . "\n" |
39 | . q[ $value = $value->value;] . "\n" |
40 | . q[ }] . "\n" |
41 | . q[ $value] . "\n" |
42 | . q[}]; |
43 | }; |
44 | |
45 | sub inline_get_is_lvalue { 0 } |
46 | } |
47 | |
48 | { |
49 | package Foo; |
50 | use Moose; |
51 | Moose::Util::MetaRole::apply_metaroles( |
52 | for => __PACKAGE__, |
53 | class_metaroles => { |
54 | instance => ['Foo::Meta::Instance'], |
55 | } |
56 | ); |
57 | |
b10dde3a |
58 | ::is( ::exception { |
5f7780bb |
59 | has array => ( |
60 | traits => ['Array'], |
61 | isa => 'ArrayRef', |
62 | default => sub { [] }, |
63 | handles => { |
64 | array_count => 'count', |
65 | array_elements => 'elements', |
66 | array_is_empty => 'is_empty', |
67 | array_push => 'push', |
68 | array_push_curried => [ push => 42, 84 ], |
69 | array_unshift => 'unshift', |
70 | array_unshift_curried => [ unshift => 42, 84 ], |
71 | array_pop => 'pop', |
72 | array_shift => 'shift', |
73 | array_get => 'get', |
74 | array_get_curried => [ get => 1 ], |
75 | array_set => 'set', |
76 | array_set_curried_1 => [ set => 1 ], |
77 | array_set_curried_2 => [ set => ( 1, 98 ) ], |
78 | array_accessor => 'accessor', |
79 | array_accessor_curried_1 => [ accessor => 1 ], |
80 | array_accessor_curried_2 => [ accessor => ( 1, 90 ) ], |
81 | array_clear => 'clear', |
82 | array_delete => 'delete', |
83 | array_delete_curried => [ delete => 1 ], |
84 | array_insert => 'insert', |
85 | array_insert_curried => [ insert => ( 1, 101 ) ], |
86 | array_splice => 'splice', |
87 | array_splice_curried_1 => [ splice => 1 ], |
88 | array_splice_curried_2 => [ splice => 1, 2 ], |
89 | array_splice_curried_all => [ splice => 1, 2, ( 3, 4, 5 ) ], |
90 | array_sort => 'sort', |
91 | array_sort_curried => |
92 | [ sort => ( sub { $_[1] <=> $_[0] } ) ], |
93 | array_sort_in_place => 'sort_in_place', |
94 | array_sort_in_place_curried => |
95 | [ sort_in_place => ( sub { $_[1] <=> $_[0] } ) ], |
96 | array_map => 'map', |
97 | array_map_curried => [ map => ( sub { $_ + 1 } ) ], |
98 | array_grep => 'grep', |
99 | array_grep_curried => [ grep => ( sub { $_ < 5 } ) ], |
100 | array_first => 'first', |
101 | array_first_curried => [ first => ( sub { $_ % 2 } ) ], |
102 | array_join => 'join', |
103 | array_join_curried => [ join => '-' ], |
104 | array_shuffle => 'shuffle', |
105 | array_uniq => 'uniq', |
106 | array_reduce => 'reduce', |
107 | array_reduce_curried => |
108 | [ reduce => ( sub { $_[0] * $_[1] } ) ], |
109 | array_natatime => 'natatime', |
110 | array_natatime_curried => [ natatime => 2 ], |
111 | }, |
112 | ); |
b10dde3a |
113 | }, undef, "native array trait inlines properly" ); |
5f7780bb |
114 | |
b10dde3a |
115 | ::is( ::exception { |
5f7780bb |
116 | has bool => ( |
117 | traits => ['Bool'], |
118 | isa => 'Bool', |
119 | default => 0, |
120 | handles => { |
121 | bool_illuminate => 'set', |
122 | bool_darken => 'unset', |
123 | bool_flip_switch => 'toggle', |
124 | bool_is_dark => 'not', |
125 | }, |
126 | ); |
b10dde3a |
127 | }, undef, "native bool trait inlines properly" ); |
5f7780bb |
128 | |
b10dde3a |
129 | ::is( ::exception { |
5f7780bb |
130 | has code => ( |
131 | traits => ['Code'], |
132 | isa => 'CodeRef', |
133 | default => sub { sub { } }, |
134 | handles => { |
135 | code_execute => 'execute', |
136 | code_execute_method => 'execute_method', |
137 | }, |
138 | ); |
b10dde3a |
139 | }, undef, "native code trait inlines properly" ); |
5f7780bb |
140 | |
b10dde3a |
141 | ::is( ::exception { |
5f7780bb |
142 | has counter => ( |
143 | traits => ['Counter'], |
144 | isa => 'Int', |
145 | default => 0, |
146 | handles => { |
147 | inc_counter => 'inc', |
148 | inc_counter_2 => [ inc => 2 ], |
149 | dec_counter => 'dec', |
150 | dec_counter_2 => [ dec => 2 ], |
151 | reset_counter => 'reset', |
152 | set_counter => 'set', |
153 | set_counter_42 => [ set => 42 ], |
154 | }, |
155 | ); |
b10dde3a |
156 | }, undef, "native counter trait inlines properly" ); |
5f7780bb |
157 | |
b10dde3a |
158 | ::is( ::exception { |
5f7780bb |
159 | has hash => ( |
160 | traits => ['Hash'], |
161 | isa => 'HashRef', |
162 | default => sub { {} }, |
163 | handles => { |
164 | hash_option_accessor => 'accessor', |
165 | hash_quantity => [ accessor => 'quantity' ], |
166 | hash_clear_options => 'clear', |
167 | hash_num_options => 'count', |
168 | hash_delete_option => 'delete', |
169 | hash_is_defined => 'defined', |
170 | hash_options_elements => 'elements', |
171 | hash_has_option => 'exists', |
172 | hash_get_option => 'get', |
173 | hash_has_no_options => 'is_empty', |
174 | hash_key_value => 'kv', |
175 | hash_set_option => 'set', |
176 | }, |
177 | ); |
b10dde3a |
178 | }, undef, "native hash trait inlines properly" ); |
5f7780bb |
179 | |
b10dde3a |
180 | ::is( ::exception { |
5f7780bb |
181 | has number => ( |
182 | traits => ['Number'], |
183 | isa => 'Num', |
184 | default => 0, |
185 | handles => { |
186 | num_abs => 'abs', |
187 | num_add => 'add', |
188 | num_inc => [ add => 1 ], |
189 | num_div => 'div', |
190 | num_cut_in_half => [ div => 2 ], |
191 | num_mod => 'mod', |
192 | num_odd => [ mod => 2 ], |
193 | num_mul => 'mul', |
194 | num_set => 'set', |
195 | num_sub => 'sub', |
196 | num_dec => [ sub => 1 ], |
197 | }, |
198 | ); |
b10dde3a |
199 | }, undef, "native number trait inlines properly" ); |
5f7780bb |
200 | |
b10dde3a |
201 | ::is( ::exception { |
5f7780bb |
202 | has string => ( |
0cfc2850 |
203 | traits => ['String'], |
204 | is => 'ro', |
205 | isa => 'Str', |
206 | default => '', |
207 | handles => { |
5f7780bb |
208 | string_inc => 'inc', |
209 | string_append => 'append', |
210 | string_append_curried => [ append => '!' ], |
211 | string_prepend => 'prepend', |
212 | string_prepend_curried => [ prepend => '-' ], |
213 | string_replace => 'replace', |
214 | string_replace_curried => [ replace => qr/(.)$/, sub { uc $1 } ], |
215 | string_chop => 'chop', |
216 | string_chomp => 'chomp', |
217 | string_clear => 'clear', |
218 | string_match => 'match', |
219 | string_match_curried => [ match => qr/\D/ ], |
220 | string_length => 'length', |
221 | string_substr => 'substr', |
222 | string_substr_curried_1 => [ substr => (1) ], |
223 | string_substr_curried_2 => [ substr => ( 1, 3 ) ], |
224 | string_substr_curried_3 => [ substr => ( 1, 3, 'ong' ) ], |
0cfc2850 |
225 | }, |
226 | ); |
b10dde3a |
227 | }, undef, "native string trait inlines properly" ); |
0cfc2850 |
228 | } |
229 | |
230 | with_immutable { |
231 | { |
5f7780bb |
232 | my $foo = Foo->new(string => 'a'); |
233 | is($foo->string, 'a'); |
234 | $foo->string_append('b'); |
235 | is($foo->string, 'ab'); |
0cfc2850 |
236 | } |
237 | |
238 | { |
5f7780bb |
239 | my $foo = Foo->new(string => ''); |
240 | $foo->{string} = ValueContainer->new(value => 'a'); |
241 | is($foo->string, 'a'); |
242 | $foo->string_append('b'); |
243 | is($foo->string, 'ab'); |
0cfc2850 |
244 | } |
245 | } 'Foo'; |
246 | |
247 | done_testing; |