t/native_traits/trait_code.t

   1 use strict;
   2 use warnings;
   3
   4 use lib 't/lib';
   5
   6 use Moose ();
   7 use NoInlineAttribute;
   8 use Test::More;
   9 use Test::Moose;
  10
  11 {
  12     my $name = 'Foo1';
  13
  14     sub build_class {
  15         my ( $attr1, $attr2, $attr3, $no_inline ) = @_;
  16
  17         my $class = Moose::Meta::Class->create(
  18             $name++,
  19             superclasses => ['Moose::Object'],
  20         );
  21
  22         my @traits = 'Code';
  23         push @traits, 'NoInlineAttribute'
  24             if $no_inline;
  25
  26         $class->add_attribute(
  27             callback => (
  28                 traits   => \@traits,
  29                 isa      => 'CodeRef',
  30                 required => 1,
  31                 handles  => { 'invoke_callback' => 'execute' },
  32                 %{ $attr1 || {} },
  33             )
  34         );
  35
  36         $class->add_attribute(
  37             callback_method => (
  38                 traits   => \@traits,
  39                 isa      => 'CodeRef',
  40                 required => 1,
  41                 handles  => { 'invoke_method_callback' => 'execute_method' },
  42                 %{ $attr2 || {} },
  43             )
  44         );
  45
  46         $class->add_attribute(
  47             multiplier => (
  48                 traits   => \@traits,
  49                 isa      => 'CodeRef',
  50                 required => 1,
  51                 handles  => { 'multiply' => 'execute' },
  52                 %{ $attr3 || {} },
  53             )
  54         );
  55
  56         return $class->name;
  57     }
  58 }
  59
  60 {
  61     my $i;
  62
  63     my %subs = (
  64         callback        => sub { ++$i },
  65         callback_method => sub { shift->multiply(@_) },
  66         multiplier      => sub { $_[0] * 2 },
  67     );
  68
  69     run_tests( build_class, \$i, \%subs );
  70
  71     run_tests( build_class( undef, undef, undef, 1 ), \$i, \%subs );
  72
  73     run_tests(
  74         build_class(
  75             {
  76                 lazy => 1, default => sub { $subs{callback} }
  77             }, {
  78                 lazy => 1, default => sub { $subs{callback_method} }
  79             }, {
  80                 lazy => 1, default => sub { $subs{multiplier} }
  81             },
  82         ),
  83         \$i,
  84     );
  85 }
  86
  87 sub run_tests {
  88     my ( $class, $iref, @args ) = @_;
  89
  90     ok(
  91         !$class->can($_),
  92         "Code trait didn't create reader method for $_"
  93     ) for qw(callback callback_method multiplier);
  94
  95     with_immutable {
  96         ${$iref} = 0;
  97         my $obj = $class->new(@args);
  98
  99         $obj->invoke_callback;
 100
 101         is( ${$iref}, 1, '$i is 1 after invoke_callback' );
 102
 103         is(
 104             $obj->invoke_method_callback(3), 6,
 105             'invoke_method_callback calls multiply with @_'
 106         );
 107
 108         is( $obj->multiply(3), 6, 'multiple double value' );
 109     }
 110     $class;
 111 }
 112
 113 done_testing;