use strict; use warnings; use Test::More; use Test::Fatal; use Test::Moose; { package ValueContainer; use Moose; has value => ( is => 'rw', ); } { package Foo::Meta::Instance; use Moose::Role; around get_slot_value => sub { my $orig = shift; my $self = shift; my ($instance, $slot_name) = @_; my $value = $self->$orig(@_); if ($value->isa('ValueContainer')) { $value = $value->value; } return $value; }; around inline_get_slot_value => sub { my $orig = shift; my $self = shift; my $value = $self->$orig(@_); return q[do {] . "\n" . q[ my $value = ] . $value . q[;] . "\n" . q[ if ($value->isa('ValueContainer')) {] . "\n" . q[ $value = $value->value;] . "\n" . q[ }] . "\n" . q[ $value] . "\n" . q[}]; }; sub inline_get_is_lvalue { 0 } } { package Foo; use Moose; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { instance => ['Foo::Meta::Instance'], } ); ::is( ::exception { has array => ( traits => ['Array'], isa => 'ArrayRef', default => sub { [] }, handles => { array_count => 'count', array_elements => 'elements', array_is_empty => 'is_empty', array_push => 'push', array_push_curried => [ push => 42, 84 ], array_unshift => 'unshift', array_unshift_curried => [ unshift => 42, 84 ], array_pop => 'pop', array_shift => 'shift', array_get => 'get', array_get_curried => [ get => 1 ], array_set => 'set', array_set_curried_1 => [ set => 1 ], array_set_curried_2 => [ set => ( 1, 98 ) ], array_accessor => 'accessor', array_accessor_curried_1 => [ accessor => 1 ], array_accessor_curried_2 => [ accessor => ( 1, 90 ) ], array_clear => 'clear', array_delete => 'delete', array_delete_curried => [ delete => 1 ], array_insert => 'insert', array_insert_curried => [ insert => ( 1, 101 ) ], array_splice => 'splice', array_splice_curried_1 => [ splice => 1 ], array_splice_curried_2 => [ splice => 1, 2 ], array_splice_curried_all => [ splice => 1, 2, ( 3, 4, 5 ) ], array_sort => 'sort', array_sort_curried => [ sort => ( sub { $_[1] <=> $_[0] } ) ], array_sort_in_place => 'sort_in_place', array_sort_in_place_curried => [ sort_in_place => ( sub { $_[1] <=> $_[0] } ) ], array_map => 'map', array_map_curried => [ map => ( sub { $_ + 1 } ) ], array_grep => 'grep', array_grep_curried => [ grep => ( sub { $_ < 5 } ) ], array_first => 'first', array_first_curried => [ first => ( sub { $_ % 2 } ) ], array_join => 'join', array_join_curried => [ join => '-' ], array_shuffle => 'shuffle', array_uniq => 'uniq', array_reduce => 'reduce', array_reduce_curried => [ reduce => ( sub { $_[0] * $_[1] } ) ], array_natatime => 'natatime', array_natatime_curried => [ natatime => 2 ], }, ); }, undef, "native array trait inlines properly" ); ::is( ::exception { has bool => ( traits => ['Bool'], isa => 'Bool', default => 0, handles => { bool_illuminate => 'set', bool_darken => 'unset', bool_flip_switch => 'toggle', bool_is_dark => 'not', }, ); }, undef, "native bool trait inlines properly" ); ::is( ::exception { has code => ( traits => ['Code'], isa => 'CodeRef', default => sub { sub { } }, handles => { code_execute => 'execute', code_execute_method => 'execute_method', }, ); }, undef, "native code trait inlines properly" ); ::is( ::exception { has counter => ( traits => ['Counter'], isa => 'Int', default => 0, handles => { inc_counter => 'inc', inc_counter_2 => [ inc => 2 ], dec_counter => 'dec', dec_counter_2 => [ dec => 2 ], reset_counter => 'reset', set_counter => 'set', set_counter_42 => [ set => 42 ], }, ); }, undef, "native counter trait inlines properly" ); ::is( ::exception { has hash => ( traits => ['Hash'], isa => 'HashRef', default => sub { {} }, handles => { hash_option_accessor => 'accessor', hash_quantity => [ accessor => 'quantity' ], hash_clear_options => 'clear', hash_num_options => 'count', hash_delete_option => 'delete', hash_is_defined => 'defined', hash_options_elements => 'elements', hash_has_option => 'exists', hash_get_option => 'get', hash_has_no_options => 'is_empty', hash_key_value => 'kv', hash_set_option => 'set', }, ); }, undef, "native hash trait inlines properly" ); ::is( ::exception { has number => ( traits => ['Number'], isa => 'Num', default => 0, handles => { num_abs => 'abs', num_add => 'add', num_inc => [ add => 1 ], num_div => 'div', num_cut_in_half => [ div => 2 ], num_mod => 'mod', num_odd => [ mod => 2 ], num_mul => 'mul', num_set => 'set', num_sub => 'sub', num_dec => [ sub => 1 ], }, ); }, undef, "native number trait inlines properly" ); ::is( ::exception { has string => ( traits => ['String'], is => 'ro', isa => 'Str', default => '', handles => { string_inc => 'inc', string_append => 'append', string_append_curried => [ append => '!' ], string_prepend => 'prepend', string_prepend_curried => [ prepend => '-' ], string_replace => 'replace', string_replace_curried => [ replace => qr/(.)$/, sub { uc $1 } ], string_chop => 'chop', string_chomp => 'chomp', string_clear => 'clear', string_match => 'match', string_match_curried => [ match => qr/\D/ ], string_length => 'length', string_substr => 'substr', string_substr_curried_1 => [ substr => (1) ], string_substr_curried_2 => [ substr => ( 1, 3 ) ], string_substr_curried_3 => [ substr => ( 1, 3, 'ong' ) ], }, ); }, undef, "native string trait inlines properly" ); } with_immutable { { my $foo = Foo->new(string => 'a'); is($foo->string, 'a'); $foo->string_append('b'); is($foo->string, 'ab'); } { my $foo = Foo->new(string => ''); $foo->{string} = ValueContainer->new(value => 'a'); is($foo->string, 'a'); $foo->string_append('b'); is($foo->string, 'ab'); } } 'Foo'; done_testing;