From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 18 Jun 2012 07:55:41 +0000 (+0100)
Subject: support has '+foo'
X-Git-Tag: v0.091008~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9f10cfe08cb754b4cdb85c1ac771606fbb98c770;hp=6067158cf3146f758b7975688b2ac124f2992a34;p=gitmo%2FMoo.git

support has '+foo'
---

diff --git a/Changes b/Changes
index 632d0cf..3f4b63e 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - handle "has '+foo'" for attrs from superclass or consumed role
   - document override -> around translation
   - use D::GD if installed rather than re-adding it as a requirement
 
diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 05d4764..10040e9 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -17,6 +17,7 @@ BEGIN {
 
 sub generate_method {
   my ($self, $into, $name, $spec, $quote_opts) = @_;
+  $name =~ s/^\+//;
   die "Must have an is" unless my $is = $spec->{is};
   if ($is eq 'ro') {
     $spec->{reader} = $name unless exists $spec->{reader};
@@ -460,7 +461,8 @@ sub _generate_xs {
   my ($self, $type, $into, $name, $slot) = @_;
   Class::XSAccessor->import(
     class => $into,
-    $type => { $name => $slot }
+    $type => { $name => $slot },
+    replace => 1,
   );
   $into->can($name);
 }
diff --git a/lib/Method/Generate/Constructor.pm b/lib/Method/Generate/Constructor.pm
index 9dae34b..e0746d7 100644
--- a/lib/Method/Generate/Constructor.pm
+++ b/lib/Method/Generate/Constructor.pm
@@ -10,6 +10,14 @@ sub register_attribute_specs {
   my ($self, @new_specs) = @_;
   my $specs = $self->{attribute_specs}||={};
   while (my ($name, $new_spec) = splice @new_specs, 0, 2) {
+    if ($name =~ s/^\+//) {
+      die "has '+${name}' given but no ${name} attribute already exists"
+        unless my $old_spec = $specs->{$name};
+      foreach my $key (keys %$old_spec) {
+        $new_spec->{$key} = $old_spec->{$key}
+          unless exists $new_spec->{$key};
+        }
+      }
     $new_spec->{index} = scalar keys %$specs
       unless defined $new_spec->{index};
     $specs->{$name} = $new_spec;
diff --git a/t/has-plus.t b/t/has-plus.t
new file mode 100644
index 0000000..79e8db8
--- /dev/null
+++ b/t/has-plus.t
@@ -0,0 +1,63 @@
+use strictures 1;
+use Test::More;
+use Test::Fatal;
+
+{
+  package RollyRole;
+
+  use Moo::Role;
+
+  has f => (is => 'ro', default => sub { 0 });
+}
+
+{
+  package ClassyClass;
+
+  use Moo;
+
+  has f => (is => 'ro', default => sub { 1 });
+}
+
+{
+  package UsesTheRole;
+
+  use Moo;
+
+  with 'RollyRole';
+}
+
+{
+  package UsesTheRole2;
+
+  use Moo;
+
+  with 'RollyRole';
+
+  has '+f' => (default => sub { 2 });
+}
+
+{
+
+  package ExtendsTheClass;
+
+  use Moo;
+
+  extends 'ClassyClass';
+
+  has '+f' => (default => sub { 3 });
+}
+
+{
+  package BlowsUp;
+
+  use Moo;
+
+  ::like(::exception { has '+f' => () }, qr/\Qhas '+f'/, 'Kaboom');
+}
+
+is(UsesTheRole->new->f, 0, 'role attr');
+is(ClassyClass->new->f, 1, 'class attr');
+is(UsesTheRole2->new->f, 2, 'role attr with +');
+is(ExtendsTheClass->new->f, 3, 'class attr with +');
+
+done_testing;