And the same fix for role_type

[gitmo/Moose.git] / lib / Moose / Util / TypeConstraints.pm

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 6e4e2fa..b44a0eb 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -155,18 +155,25 @@ 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 = $options->{package_defined_in} || scalar( caller(1) );
+
     if (my $type = $REGISTRY->get_type_constraint($class)) {
-        my $pkg_defined_in = scalar( caller(1) );
-        _confess(
-            "The type constraint '$class' has already been created in "
-          . $type->_package_defined_in
-          . " and cannot be created again in "
-          . $pkg_defined_in )
+        if (!($type->isa('Moose::Meta::TypeConstraint::Class') && $type->class eq $class)) {
+            _confess(
+                "The type constraint '$class' has already been created in "
+              . $type->_package_defined_in
+              . " and cannot be created again in "
+              . $pkg_defined_in )
+        }
+        else {
+            return $type;
+        }
     }
 
     my %options = (
-        class => $class,
-        name  => $class,
+        class              => $class,
+        name               => $class,
+        package_defined_in => $pkg_defined_in,
         %{ $options || {} },
     );
 
@@ -184,18 +191,25 @@ 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 = $options->{package_defined_in} || scalar( caller(1) );
+
     if (my $type = $REGISTRY->get_type_constraint($role)) {
-        my $pkg_defined_in = scalar( caller(1) );
-        _confess(
-            "The type constraint '$role' has already been created in "
-          . $type->_package_defined_in
-          . " and cannot be created again in "
-          . $pkg_defined_in )
+        if (!($type->isa('Moose::Meta::TypeConstraint::Role') && $type->role eq $role)) {
+            _confess(
+                "The type constraint '$role' has already been created in "
+              . $type->_package_defined_in
+              . " and cannot be created again in "
+              . $pkg_defined_in )
+        }
+        else {
+            return $type;
+        }
     }
 
     my %options = (
-        role => $role,
-        name => $role,
+        role               => $role,
+        name               => $role,
+        package_defined_in => $pkg_defined_in,
         %{ $options || {} },
     );
 
@@ -236,15 +250,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 {
@@ -1108,15 +1122,9 @@ The subroutine should return a code string suitable for inlining. You can
 assume that the check will be wrapped in parentheses when it is inlined.
 
 The inlined code should include any checks that your type's parent types
-do. For example, the C<Value> type's inlining sub looks like this:
-
-    sub {
-        'defined(' . $_[1] . ')'
-        . ' && !ref(' . $_[1] . ')'
-    }
-
-Note that it checks if the variable is defined, since it is a subtype of
-the C<Defined> type.  However, to avoid repeating code, this can be optimized as:
+do. If your parent type constraint defines its own inlining, you can simply use
+that to avoid repeating code. For example, here is the inlining code for the
+C<Value> type, which is a subtype of C<Defined>:
 
     sub {
         $_[0]->parent()->_inline_check($_[1])