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
  47 {
  48   package ArrayTest1;
  49
  50   use Moo;
  51
  52   BEGIN {
  53      Moo::Role->apply_roles_to_object(
  54        Moo->_accessor_maker_for(__PACKAGE__),
  55       'Method::Generate::Accessor::Role::ArrayRefInstance'
  56      )
  57   }
  58
  59   has one => (is => 'ro');
  60   has two => (is => 'ro');
  61   has three => (is => 'ro');
  62 }
  63
  64 my $o = ArrayTest1->new(one => 1, two => 2, three => 3);
  65
  66 is_deeply([ @$o ], [ 1, 2, 3 ], 'Basic object ok');
  67
  68 {
  69   package ArrayTest2;
  70
  71   use Moo;
  72
  73   extends 'ArrayTest1';
  74
  75   has four => (is => 'ro');
  76 }
  77
  78 $o = ArrayTest2->new(one => 1, two => 2, three => 3, four => 4);
  79
  80 is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object ok');
  81
  82 done_testing;