improve the warning for unknown attribute parameters (mjd)

[gitmo/Moose.git] / lib / Moose / Meta / Attribute.pm

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 7f35161..46a8412 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -94,7 +94,22 @@ sub new {
 
     if (@bad)
     {
-        Carp::cluck "Found unknown argument(s) passed to '$name' attribute constructor in '$class': @bad";
+        my $s = @bad > 1 ? 's' : '';
+        my $list = join "', '", @bad;
+
+        my $package = $options{definition_context}{package};
+        my $context = $options{definition_context}{context}
+                   || 'attribute constructor';
+        my $type = $options{definition_context}{type} || 'class';
+
+        my $location = '';
+        if (defined($package)) {
+            $location = " in ";
+            $location .= "$type " if $type;
+            $location .= $package;
+        }
+
+        Carp::cluck "Found unknown argument$s '$list' in the $context for '$name'$location";
     }
 
     return $class->SUPER::new($name, %options);
@@ -217,7 +232,7 @@ sub clone_and_inherit_options {
             $type_constraint = $options{isa};
         }
         else {
-            $type_constraint = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options{isa});
+            $type_constraint = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options{isa}, { package_defined_in => $options{definition_context}->{package} });
             (defined $type_constraint)
                 || $self->throw_error("Could not find the type constraint '" . $options{isa} . "'", data => $options{isa});
         }
@@ -231,7 +246,7 @@ sub clone_and_inherit_options {
             $type_constraint = $options{does};
         }
         else {
-            $type_constraint = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options{does});
+            $type_constraint = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options{does}, { package_defined_in => $options{definition_context}->{package} });
             (defined $type_constraint)
                 || $self->throw_error("Could not find the type constraint '" . $options{does} . "'", data => $options{does});
         }
@@ -362,7 +377,9 @@ sub _process_isa_option {
     else {
         $options->{type_constraint}
             = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint(
-            $options->{isa} );
+            $options->{isa},
+            { package_defined_in => $options->{definition_context}->{package} }
+        );
     }
 }
 
@@ -379,7 +396,9 @@ sub _process_does_option {
     else {
         $options->{type_constraint}
             = Moose::Util::TypeConstraints::find_or_create_does_type_constraint(
-            $options->{does} );
+            $options->{does},
+            { package_defined_in => $options->{definition_context}->{package} }
+        );
     }
 }
 
@@ -644,8 +663,7 @@ sub _inline_check_required {
     return (
         'if (@_ < 2) {',
             $self->_inline_throw_error(
-                '"Attribute (' . $attr_name . ') is required, so cannot '
-              . 'be set to undef"' # defined $_[1] is not good enough
+                '"Attribute (' . $attr_name . ') is required"'
             ) . ';',
         '}',
     );
@@ -745,7 +763,7 @@ sub _inline_weaken_value {
 
     my $mi = $self->associated_class->get_meta_instance;
     return (
-        $mi->inline_weaken_slot_value($instance, $self->name, $value),
+        $mi->inline_weaken_slot_value($instance, $self->name),
             'if ref ' . $value . ';',
     );
 }
@@ -821,6 +839,10 @@ sub get_value {
             $value = $self->_coerce_and_verify( $value, $instance );
 
             $self->set_initial_value($instance, $value);
+
+            if ( ref $value && $self->is_weak_ref ) {
+                $self->_weaken_value($instance);
+            }
         }
     }
 
@@ -902,6 +924,7 @@ sub _inline_init_from_default {
                $self->_inline_check_constraint($default, $tc, $message, $for_lazy))
             : (),
         $self->_inline_init_slot($instance, $default),
+        $self->_inline_weaken_value($instance, $default),
     );
 }
 
@@ -1084,8 +1107,12 @@ sub install_delegation {
         my $class_name = $associated_class->name;
         my $name = "${class_name}::${handle}";
 
-            (!$associated_class->has_method($handle))
-                || $self->throw_error("You cannot overwrite a locally defined method ($handle) with a delegation", method_name => $handle);
+        if ( my $method = $associated_class->get_method($handle) ) {
+            $self->throw_error(
+                "You cannot overwrite a locally defined method ($handle) with a delegation",
+                method_name => $handle
+            ) unless $method->is_stub;
+        }
 
         # NOTE:
         # handles is not allowed to delegate
@@ -1294,7 +1321,7 @@ L<Class::MOP::Attribute> and add Moose specific features.
 
 =over 4
 
-=item B<< Moose::Meta::Attribute->new(%options) >>
+=item B<< Moose::Meta::Attribute->new($name, %options) >>
 
 This method overrides the L<Class::MOP::Attribute> constructor.
 
@@ -1462,14 +1489,14 @@ I<Attribute (x) does not pass the type constraint (Int) with 'forty-two'>
 
 Before setting the value, a check is made on the type constraint of
 the attribute, if it has one, to see if the value passes it. If the
-value fails to pass, the set operation dies with a L</throw_error>.
+value fails to pass, the set operation dies.
 
 Any coercion to convert values is done before checking the type constraint.
 
 To check a value against a type constraint before setting it, fetch the
 attribute instance using L<Class::MOP::Class/find_attribute_by_name>,
 fetch the type_constraint from the attribute using L<Moose::Meta::Attribute/type_constraint>
-and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::Basics::Recipe4>
+and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::Basics::Company_Subtypes>
 for an example.
 
 =back