Merge branch 'topic/native-trait-bugfix'

Conflicts:
	Changes
	lib/Moose/Meta/Method/Accessor/Native/Collection.pm

diff --combined Changes
index e73dbcd,4501c9b..a99d871
--- 1/Changes
--- 2/Changes
+++ b/Changes
@@@ -3,22 -3,12 +3,28 @@@ for, noteworthy changes
  
  NEXT
  
 +  [API CHANGES]
 +
 +  * Roles now have their own default attribute metaclass to use during
 +    application to a class, rather than just using the class's
 +    attribute_metaclass. This is also overridable via ::MetaRole, with the
 +    applied_attribute key in the role_metaroles hashref (doy).
 +
 +  * The internal code used to generate inlined methods (accessor, constructor,
 +    etc.) has been massively rewritten. MooseX modules that do inlining will
 +    almost certainly need to be updated as well.
 +
 +  [ENHANCEMENTS]
 +
 +  * We now load the roles needed for native delegations only as needed. This
 +    speeds up the compilation time for Moose itself. (doy)
 +
+   [BUG FIXES]
+ 
+   * When using native delegations, if an array or hash ref member failed a
+     type constraint check, Moose ended up erroring out with "Can't call method
+     "get_message" on unblessed reference" instead of generating a useful error
+     based on the failed type constraint. Reported by t0m. (Dave Rolsky)
  
  1.19 Tue, Nov 2, 2010
  

diff --combined lib/Moose/Meta/Method/Accessor/Native/Collection.pm
index 5e75523,1721523..26cf3c5
--- 1/lib/Moose/Meta/Method/Accessor/Native/Collection.pm
--- 2/lib/Moose/Meta/Method/Accessor/Native/Collection.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Collection.pm
@@@ -11,18 -11,20 +11,18 @@@ use Moose::Role
  
  requires qw( _adds_members );
  
 -around _inline_coerce_new_values => sub {
 -    shift;
 +sub _inline_coerce_new_values {
      my $self = shift;
  
 -    return q{} unless $self->associated_attribute->should_coerce;
 +    return unless $self->associated_attribute->should_coerce;
  
 -    return q{} unless $self->_tc_member_type_can_coerce;
 +    return unless $self->_tc_member_type_can_coerce;
  
 -    return
 -          '('
 -        . $self->_new_members
 -        . ') = map { $member_tc_obj->coerce($_) } '
 -        . $self->_new_members . ';';
 -};
 +    return (
 +        '(' . $self->_new_members . ') = map { $member_tc_obj->coerce($_) }',
 +                                             $self->_new_members . ';',
 +    );
 +}
  
  sub _tc_member_type_can_coerce {
      my $self = shift;
@@@ -35,40 -37,43 +35,40 @@@
  sub _tc_member_type {
      my $self = shift;
  
 -    for (
 -        my $tc = $self->associated_attribute->type_constraint;
 -        $tc;
 -        $tc = $tc->parent
 -        ) {
 -
 +    my $tc = $self->associated_attribute->type_constraint;
 +    while ($tc) {
          return $tc->type_parameter
              if $tc->can('type_parameter');
 +        $tc = $tc->parent;
      }
  
      return;
  }
  
 -around _value_needs_copy => sub {
 -    shift;
 +sub _writer_value_needs_copy {
      my $self = shift;
  
      return $self->_constraint_must_be_checked
          && !$self->_check_new_members_only;
 -};
 +}
  
 -around _inline_tc_code => sub {
 -    shift;
 -    my ( $self, $potential_value ) = @_;
 +sub _inline_tc_code {
 +    my $self = shift;
  
 -    return q{} unless $self->_constraint_must_be_checked;
 +    return unless $self->_constraint_must_be_checked;
  
 -    if ( $self->_check_new_members_only ) {
 -        return q{} unless $self->_adds_members;
 +    if ($self->_check_new_members_only) {
 +        return unless $self->_adds_members;
  
 -        return $self->_inline_check_member_constraint( $self->_new_members );
 +        return $self->_inline_check_member_constraint($self->_new_members);
      }
      else {
 -        return $self->_inline_check_coercion($potential_value) . "\n"
 -            . $self->_inline_check_constraint($potential_value);
 +        return (
 +            $self->_inline_check_coercion(@_),
 +            $self->_inline_check_constraint(@_),
 +        );
      }
 -};
 +}
  
  sub _check_new_members_only {
      my $self = shift;
@@@ -96,38 -101,31 +96,38 @@@
  }
  
  sub _inline_check_member_constraint {
 -    my ( $self, $new_value ) = @_;
 +    my $self = shift;
 +    my ($new_value) = @_;
  
      my $attr_name = $self->associated_attribute->name;
  
 -    return '$member_tc->($_) || '
 -        . $self->_inline_throw_error(
 -        qq{"A new member value for '$attr_name' does not pass its type constraint because: "}
 -            . ' . $member_tc_obj->get_message($_)',
 -        "data => \$_"
 -        ) . " for $new_value;";
 +    return (
 +        'for (' . $new_value . ') {',
 +            'if (!$member_tc->($_)) {',
 +                $self->_inline_throw_error(
 +                    '"A new member value for ' . $attr_name
 +                  . ' does not pass its type constraint because: "'
-                   . ' . $member_tc->get_message($_)',
++                  . ' . $member_tc_obj->get_message($_)',
 +                    'data => $_',
 +                ) . ';',
 +            '}',
 +        '}',
 +    );
  }
  
 -around _inline_get_old_value_for_trigger => sub {
 -    shift;
 -    my ( $self, $instance ) = @_;
 +sub _inline_get_old_value_for_trigger {
 +    my $self = shift;
 +    my ($instance, $old) = @_;
  
      my $attr = $self->associated_attribute;
 -    return '' unless $attr->has_trigger;
 +    return unless $attr->has_trigger;
  
 -    return
 -          'my @old = '
 -        . $self->_inline_has($instance) . q{ ? }
 -        . $self->_inline_copy_old_value( $self->_inline_get($instance) )
 -        . ": ();\n";
 -};
 +    return (
 +        'my ' . $old . ' = ' . $self->_has_value($instance),
 +            '? ' . $self->_copy_old_value($self->_get_value($instance)),
 +            ': ();',
 +    );
 +}
  
  around _eval_environment => sub {
      my $orig = shift;