Moose-2.1405HEADMoose-2.1405master

1 files changed, 246 insertions, 0 deletions

diff --git a/t/native_traits/custom_instance.t b/t/native_traits/custom_instance.t
new file mode 100644
index 0000000..0b08339
--- /dev/null
+++ b/t/native_traits/custom_instance.t
@@ -0,0 +1,246 @@
+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;