From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Sun, 21 Apr 2013 15:23:18 +0000 (+0100)
Subject: Fix warnings about unknown attribute parameters on metaclass inflation
X-Git-Tag: v1.002000~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b6ab68373c2cde43fa4c53494e09624ea050e545;p=gitmo%2FMoo.git

Fix warnings about unknown attribute parameters on metaclass inflation

Moo::Role::_inhale_if_moose inhales the entire guts of the attribute
metaobject, so make sure we pass the correct constructor args for the
attribute metaclass.
---

diff --git a/Changes b/Changes
index f663819..06340ab 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - fix warnings about unknown attribute parameters on metaclass inflation
   - don't pass 'handles' down when doing 'has +' to avoid unDWIMmy explosions
   - throw a useful exception when typemap doesn't return a value
   - avoid localising @_ when not required for Sub::Quote
diff --git a/lib/Moo/HandleMoose.pm b/lib/Moo/HandleMoose.pm
index 15ab89e..9eea5a3 100644
--- a/lib/Moo/HandleMoose.pm
+++ b/lib/Moo/HandleMoose.pm
@@ -95,15 +95,18 @@ sub inject_real_metaclass_for {
   Sub::Defer::undefer_sub($_) for grep defined, values %methods;
   my @attrs;
   {
+    my %spec_map = (
+      map { $_->name => $_->init_arg }
+      grep { $_->has_init_arg }
+      $meta->attribute_metaclass->meta->get_all_attributes
+    );
     # This local is completely not required for roles but harmless
     local @{_getstash($name)}{keys %methods};
     my %seen_name;
     foreach my $name (@$attr_order) {
       $seen_name{$name} = 1;
       my %spec = %{$attr_specs->{$name}};
-      delete $spec{index};
       $spec{is} = 'ro' if $spec{is} eq 'lazy' or $spec{is} eq 'rwp';
-      delete $spec{asserter};
       my $coerce = $spec{coerce};
       if (my $isa = $spec{isa}) {
         my $tc = $spec{isa} = do {
@@ -136,6 +139,10 @@ sub inject_real_metaclass_for {
         $spec{isa} = $tc;
         $spec{coerce} = 1;
       }
+      %spec =
+        map { $spec_map{$_} => $spec{$_} }
+        grep { exists $spec_map{$_} }
+        keys %spec;
       push @attrs, $meta->add_attribute($name => %spec);
     }
     foreach my $mouse (do { our %MOUSE; @{$MOUSE{$name}||[]} }) {
diff --git a/xt/moo-does-moose-role.t b/xt/moo-does-moose-role.t
index 4e4fa10..ff9f6d2 100644
--- a/xt/moo-does-moose-role.t
+++ b/xt/moo-does-moose-role.t
@@ -191,6 +191,12 @@ BEGIN {
     $spec->{documentation} .= 'child';
   });
 }
+BEGIN{
+  local $SIG{__WARN__} = sub { fail "warning: $_[0]" };
+  package SplatteredMoose;
+  use Moose;
+  extends 'Splattered';
+}
 
 foreach my $s (
     Splattered->new,
@@ -199,14 +205,15 @@ foreach my $s (
     Ker::Splattered2->new,
     KerSplattered->new,
     KerSplattered2->new,
+    SplatteredMoose->new
 ) {
-  ok($s->can('punch'))
+  can_ok($s, 'punch')
     and is($s->punch, 1, 'punch');
-  ok($s->can('jab'))
+  can_ok($s, 'jab')
     and is($s->jab, 3, 'jab');
-  ok($s->can('monkey'))
+  can_ok($s, 'monkey')
     and is($s->monkey, 'OW', 'monkey');
-  ok($s->can('trap'))
+  can_ok($s, 'trap')
     and is($s->trap, -1, 'trap');
 }
 
@@ -216,8 +223,8 @@ foreach my $c (qw/
     KerSplattered
     KerSplattered2
 /) {
-  ok $c->can('has_ker');
-  ok $c->can('has_splat');
+  can_ok($c, 'has_ker');
+  can_ok($c, 'has_splat');
 }
 
 is(Plunker->meta->find_attribute_by_name('pp')->documentation, 'moosify', 'moosify modifies attr specs');
diff --git a/xt/moose-override-attribute-with-plus-syntax.t b/xt/moose-override-attribute-with-plus-syntax.t
index fb3c31e..0a9570f 100644
--- a/xt/moose-override-attribute-with-plus-syntax.t
+++ b/xt/moose-override-attribute-with-plus-syntax.t
@@ -31,6 +31,15 @@ use Test::Fatal;
     );
     __PACKAGE__->meta->make_immutable
 }
+{
+    package MooChild;
+    use Moo;
+    extends 'MooParent';
+
+    has '+foo' => (
+        default => sub { 'MooChild' },
+    );
+}
 
 is(
     MooseChild->new->foo,
@@ -44,5 +53,10 @@ is(
     'default value in Moose child'
 );
 
+is(exception {
+    local $SIG{__WARN__} = sub { die $_[0] };
+    ok(MooChild->meta->has_attribute('foo'), 'inflated metaclass has overridden attribute');
+}, undef, 'metaclass inflation of plus override works without warnings');
+
 done_testing;