Merge branch 'topic/native-trait-bugfix'
Dave Rolsky [Fri, 19 Nov 2010 15:16:53 +0000 (09:16 -0600)]
Conflicts:
Changes
lib/Moose/Meta/Method/Accessor/Native/Collection.pm

1  2 
Changes
lib/Moose/Meta/Method/Accessor/Native/Collection.pm

diff --cc 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
  
@@@ -101,33 -105,27 +101,33 @@@ sub _inline_check_member_constraint 
  
      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;