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