X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FMethod%2FAccessor%2FNative%2FCollection.pm;h=d1fcde2d8e67e5691657ac5fc25d4922ce332aad;hb=14f358ac1dd05aadfd41371b28e3fd00c01810ed;hp=711c40398eaac1515d461ab61b8397ef47b6be54;hpb=f4b86ac0e1fd7ff8a180f2f8332821170db5371e;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/Method/Accessor/Native/Collection.pm b/lib/Moose/Meta/Method/Accessor/Native/Collection.pm
index 711c403..d1fcde2 100644
--- a/lib/Moose/Meta/Method/Accessor/Native/Collection.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Collection.pm
@@ -3,7 +3,7 @@ package Moose::Meta::Method::Accessor::Native::Collection;
 use strict;
 use warnings;
 
-our $VERSION = '1.16';
+our $VERSION = '1.18';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -11,6 +11,45 @@ use Moose::Role;
 
 requires qw( _adds_members );
 
+around _inline_coerce_new_values => sub {
+    shift;
+    my $self = shift;
+
+    return q{} unless $self->associated_attribute->should_coerce;
+
+    return q{} unless $self->_tc_member_type_can_coerce;
+
+    return
+          '('
+        . $self->_new_members
+        . ') = map { $member_tc_obj->coerce($_) } '
+        . $self->_new_members . ';';
+};
+
+sub _tc_member_type_can_coerce {
+    my $self = shift;
+
+    my $member_tc = $self->_tc_member_type;
+
+    return $member_tc && $member_tc->has_coercion;
+}
+
+sub _tc_member_type {
+    my $self = shift;
+
+    for (
+        my $tc = $self->associated_attribute->type_constraint;
+        $tc;
+        $tc = $tc->parent
+        ) {
+
+        return $tc->type_parameter
+            if $tc->can('type_parameter');
+    }
+
+    return;
+}
+
 around _value_needs_copy => sub {
     shift;
     my $self = shift;
@@ -74,15 +113,6 @@ sub _inline_check_member_constraint {
         ) . " for $new_value;";
 }
 
-around _inline_check_constraint => sub {
-    my $orig = shift;
-    my $self = shift;
-
-    return q{} unless $self->_constraint_must_be_checked;
-
-    return $self->$orig( $_[0] );
-};
-
 around _inline_get_old_value_for_trigger => sub {
     shift;
     my ( $self, $instance ) = @_;
@@ -103,13 +133,13 @@ around _eval_environment => sub {
 
     my $env = $self->$orig(@_);
 
-    return $env
-        unless $self->_constraint_must_be_checked
-            && $self->_check_new_members_only;
+    my $member_tc = $self->_tc_member_type;
+
+    return $env unless $member_tc;
+
+    $env->{'$member_tc_obj'} = \($member_tc);
 
-    $env->{'$member_tc'}
-        = \( $self->associated_attribute->type_constraint->type_parameter
-            ->_compiled_type_constraint );
+    $env->{'$member_tc'} = \( $member_tc->_compiled_type_constraint );
 
     return $env;
 };