Moose-2.1405HEADMoose-2.1405master

1 files changed, 113 insertions, 0 deletions

diff --git a/t/native_traits/trait_code.t b/t/native_traits/trait_code.t
new file mode 100644
index 0000000..1590963
--- /dev/null
+++ b/t/native_traits/trait_code.t
@@ -0,0 +1,113 @@
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use Moose ();
+use NoInlineAttribute;
+use Test::More;
+use Test::Moose;
+
+{
+    my $name = 'Foo1';
+
+    sub build_class {
+        my ( $attr1, $attr2, $attr3, $no_inline ) = @_;
+
+        my $class = Moose::Meta::Class->create(
+            $name++,
+            superclasses => ['Moose::Object'],
+        );
+
+        my @traits = 'Code';
+        push @traits, 'NoInlineAttribute'
+            if $no_inline;
+
+        $class->add_attribute(
+            callback => (
+                traits   => \@traits,
+                isa      => 'CodeRef',
+                required => 1,
+                handles  => { 'invoke_callback' => 'execute' },
+                %{ $attr1 || {} },
+            )
+        );
+
+        $class->add_attribute(
+            callback_method => (
+                traits   => \@traits,
+                isa      => 'CodeRef',
+                required => 1,
+                handles  => { 'invoke_method_callback' => 'execute_method' },
+                %{ $attr2 || {} },
+            )
+        );
+
+        $class->add_attribute(
+            multiplier => (
+                traits   => \@traits,
+                isa      => 'CodeRef',
+                required => 1,
+                handles  => { 'multiply' => 'execute' },
+                %{ $attr3 || {} },
+            )
+        );
+
+        return $class->name;
+    }
+}
+
+{
+    my $i;
+
+    my %subs = (
+        callback        => sub { ++$i },
+        callback_method => sub { shift->multiply(@_) },
+        multiplier      => sub { $_[0] * 2 },
+    );
+
+    run_tests( build_class, \$i, \%subs );
+
+    run_tests( build_class( undef, undef, undef, 1 ), \$i, \%subs );
+
+    run_tests(
+        build_class(
+            {
+                lazy => 1, default => sub { $subs{callback} }
+            }, {
+                lazy => 1, default => sub { $subs{callback_method} }
+            }, {
+                lazy => 1, default => sub { $subs{multiplier} }
+            },
+        ),
+        \$i,
+    );
+}
+
+sub run_tests {
+    my ( $class, $iref, @args ) = @_;
+
+    ok(
+        !$class->can($_),
+        "Code trait didn't create reader method for $_"
+    ) for qw(callback callback_method multiplier);
+
+    with_immutable {
+        ${$iref} = 0;
+        my $obj = $class->new(@args);
+
+        $obj->invoke_callback;
+
+        is( ${$iref}, 1, '$i is 1 after invoke_callback' );
+
+        is(
+            $obj->invoke_method_callback(3), 6,
+            'invoke_method_callback calls multiply with @_'
+        );
+
+        is( $obj->multiply(3), 6, 'multiple double value' );
+    }
+    $class;
+}
+
+done_testing;