t/accessor-generator-extension.t

   1 use strictures 1;
   2 use Test::More;
   3
   4 BEGIN {
   5   package Method::Generate::Accessor::Role::ArrayRefInstance;
   6
   7   use Moo::Role;
   8
   9   sub _generate_simple_get {
  10     my ($self, $me, $name, $spec) = @_;
  11     "${me}->[${\$spec->{index}}]";
  12   }
  13
  14   sub _generate_core_set {
  15     my ($self, $me, $name, $spec, $value) = @_;
  16     "${me}->[${\$spec->{index}}] = $value";
  17   }
  18
  19   sub _generate_simple_has {
  20     my ($self, $me, $name, $spec) = @_;
  21     "defined ${me}->[${\$spec->{index}}]";
  22   }
  23
  24   sub _generate_simple_clear {
  25     my ($self, $me, $name, $spec) = @_;
  26     "undef(${me}->[${\$spec->{index}}])";
  27   }
  28
  29   sub generate_multi_set {
  30     my ($self, $me, $to_set, $from, $specs) = @_;
  31     "\@{${me}}[${\join ', ', map $specs->{$_}{index}, @$to_set}] = $from";
  32   }
  33
  34   sub _generate_xs {
  35     my ($self, $type, $into, $name, $slot, $spec) = @_;
  36     require Class::XSAccessor::Array;
  37     Class::XSAccessor::Array->import(
  38       class => $into,
  39       $type => { $name => $spec->{index} }
  40     );
  41     $into->can($name);
  42   }
  43
  44   sub default_construction_string { '[]' }
  45
  46   sub MooX::ArrayRef::import {
  47     Moo::Role->apply_roles_to_object(
  48       Moo->_accessor_maker_for(scalar caller),
  49       'Method::Generate::Accessor::Role::ArrayRefInstance'
  50     );
  51   }
  52   $INC{"MooX/ArrayRef.pm"} = 1;
  53 }
  54
  55 {
  56   package ArrayTest1;
  57
  58   use Moo;
  59   use MooX::ArrayRef;
  60
  61   has one => (is => 'ro');
  62   has two => (is => 'ro');
  63   has three => (is => 'ro');
  64 }
  65
  66 my $o = ArrayTest1->new(one => 1, two => 2, three => 3);
  67
  68 is_deeply([ @$o ], [ 1, 2, 3 ], 'Basic object ok');
  69
  70 {
  71   package ArrayTest2;
  72
  73   use Moo;
  74
  75   extends 'ArrayTest1';
  76
  77   has four => (is => 'ro');
  78 }
  79
  80 $o = ArrayTest2->new(one => 1, two => 2, three => 3, four => 4);
  81
  82 is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object ok');
  83
  84 {
  85   package ArrayTestRole;
  86
  87   use Moo::Role;
  88
  89   has four => (is => 'ro');
  90
  91   package ArrayTest3;
  92
  93   use Moo;
  94
  95   extends 'ArrayTest1';
  96
  97   with 'ArrayTestRole';
  98 }
  99
 100 $o = ArrayTest3->new(one => 1, two => 2, three => 3, four => 4);
 101
 102 is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object w/role');
 103
 104 done_testing;