X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Faccessor-generator-extension.t;fp=t%2Faccessor-generator-extension.t;h=3164bf642e4e7861bb78f60c008c7f8743610e88;hb=873df57040580aff36452de31e310003f73390fc;hp=0000000000000000000000000000000000000000;hpb=ceea0e3806c6b5e700ff9ac8d4cfb36bc1c20af9;p=gitmo%2FMoo.git

diff --git a/t/accessor-generator-extension.t b/t/accessor-generator-extension.t
new file mode 100644
index 0000000..3164bf6
--- /dev/null
+++ b/t/accessor-generator-extension.t
@@ -0,0 +1,82 @@
+use strictures 1;
+use Test::More;
+
+BEGIN {
+  package Method::Generate::Accessor::Role::ArrayRefInstance;
+
+  use Moo::Role;
+
+  sub _generate_simple_get {
+    my ($self, $me, $name, $spec) = @_;
+    "${me}->[${\$spec->{index}}]";
+  }
+
+  sub _generate_core_set {
+    my ($self, $me, $name, $spec, $value) = @_;
+    "${me}->[${\$spec->{index}}] = $value";
+  }
+
+  sub _generate_simple_has {
+    my ($self, $me, $name, $spec) = @_;
+    "defined ${me}->[${\$spec->{index}}]";
+  }
+
+  sub _generate_simple_clear {
+    my ($self, $me, $name, $spec) = @_;
+    "undef(${me}->[${\$spec->{index}}])";
+  }
+
+  sub generate_multi_set {
+    my ($self, $me, $to_set, $from, $specs) = @_;
+    "\@{${me}}[${\join ', ', map $specs->{$_}{index}, @$to_set}] = $from";
+  }
+
+  sub _generate_xs {
+    my ($self, $type, $into, $name, $slot, $spec) = @_;
+    require Class::XSAccessor::Array;
+    Class::XSAccessor::Array->import(
+      class => $into,
+      $type => { $name => $spec->{index} }
+    );
+    $into->can($name);
+  }
+
+  sub default_construction_string { '[]' }
+}
+
+{
+  package ArrayTest1;
+
+  use Moo;
+
+  BEGIN {
+     Moo::Role->apply_roles_to_object(
+       Moo->_accessor_maker_for(__PACKAGE__),
+      'Method::Generate::Accessor::Role::ArrayRefInstance'
+     )
+  }
+
+  has one => (is => 'ro');
+  has two => (is => 'ro');
+  has three => (is => 'ro');
+}
+
+my $o = ArrayTest1->new(one => 1, two => 2, three => 3);
+
+is_deeply([ @$o ], [ 1, 2, 3 ], 'Basic object ok');
+
+{
+  package ArrayTest2;
+
+  use Moo;
+
+  extends 'ArrayTest1';
+
+  has four => (is => 'ro');
+}
+
+$o = ArrayTest2->new(one => 1, two => 2, three => 3, four => 4);
+
+is_deeply([ @$o ], [ 1, 2, 3, 4 ], 'Subclass object ok');
+
+done_testing;