track implicitly created types as being created in the right place

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 5b78fd4..b314b59 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -217,7 +217,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 +231,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 +362,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 +381,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} }
+        );
     }
 }
 

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 88f1dd7..fb657ca 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -155,7 +155,7 @@ sub create_class_type_constraint {
 #find_type_constraint("ClassName")->check($class)
 #    || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name");
 
-    my $pkg_defined_in = scalar( caller(1) );
+    my $pkg_defined_in = $options->{package_defined_in} || scalar( caller(1) );
 
     if (my $type = $REGISTRY->get_type_constraint($class)) {
         if (!($type->isa('Moose::Meta::TypeConstraint::Class') && $type->class eq $class)) {
@@ -188,7 +188,7 @@ sub create_role_type_constraint {
 #find_type_constraint("ClassName")->check($class)
 #    || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name");
 
-    my $pkg_defined_in = scalar( caller(1) );
+    my $pkg_defined_in = $options->{package_defined_in} || scalar( caller(1) );
 
     if (my $type = $REGISTRY->get_type_constraint($role)) {
         if (!($type->isa('Moose::Meta::TypeConstraint::Role') && $type->role eq $role)) {
@@ -244,15 +244,15 @@ sub find_or_create_type_constraint {
 }
 
 sub find_or_create_isa_type_constraint {
-    my $type_constraint_name = shift;
+    my ($type_constraint_name, $options) = @_;
     find_or_parse_type_constraint($type_constraint_name)
-        || create_class_type_constraint($type_constraint_name);
+        || create_class_type_constraint($type_constraint_name, $options);
 }
 
 sub find_or_create_does_type_constraint {
-    my $type_constraint_name = shift;
+    my ($type_constraint_name, $options) = @_;
     find_or_parse_type_constraint($type_constraint_name)
-        || create_role_type_constraint($type_constraint_name);
+        || create_role_type_constraint($type_constraint_name, $options);
 }
 
 sub find_or_parse_type_constraint {