9 package ValueContainer;
18 package Foo::Meta::Instance;
21 around get_slot_value => sub {
24 my ($instance, $slot_name) = @_;
25 my $value = $self->$orig(@_);
26 if ($value->isa('ValueContainer')) {
27 $value = $value->value;
32 around inline_get_slot_value => sub {
35 my $value = $self->$orig(@_);
37 . q[ my $value = ] . $value . q[;] . "\n"
38 . q[ if ($value->isa('ValueContainer')) {] . "\n"
39 . q[ $value = $value->value;] . "\n"
45 sub inline_get_is_lvalue { 0 }
51 Moose::Util::MetaRole::apply_metaroles(
54 instance => ['Foo::Meta::Instance'],
62 default => sub { [] },
64 array_count => 'count',
65 array_elements => 'elements',
66 array_is_empty => 'is_empty',
68 array_push_curried => [ push => 42, 84 ],
69 array_unshift => 'unshift',
70 array_unshift_curried => [ unshift => 42, 84 ],
72 array_shift => 'shift',
74 array_get_curried => [ get => 1 ],
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 ) ],
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] } ) ],
97 array_map_curried => [ map => ( sub { $_ + 1 } ) ],
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 ],
113 }, undef, "native array trait inlines properly" );
121 bool_illuminate => 'set',
122 bool_darken => 'unset',
123 bool_flip_switch => 'toggle',
124 bool_is_dark => 'not',
127 }, undef, "native bool trait inlines properly" );
133 default => sub { sub { } },
135 code_execute => 'execute',
136 code_execute_method => 'execute_method',
139 }, undef, "native code trait inlines properly" );
143 traits => ['Counter'],
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 ],
156 }, undef, "native counter trait inlines properly" );
162 default => sub { {} },
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',
178 }, undef, "native hash trait inlines properly" );
182 traits => ['Number'],
188 num_inc => [ add => 1 ],
190 num_cut_in_half => [ div => 2 ],
192 num_odd => [ mod => 2 ],
196 num_dec => [ sub => 1 ],
199 }, undef, "native number trait inlines properly" );
203 traits => ['String'],
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' ) ],
227 }, undef, "native string trait inlines properly" );
232 my $foo = Foo->new(string => 'a');
233 is($foo->string, 'a');
234 $foo->string_append('b');
235 is($foo->string, 'ab');
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');