overriding types with class_type or role_type should die too

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

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 0b7dccf..6e4e2fa 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -155,6 +155,15 @@ 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");
 
+    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 )
+    }
+
     my %options = (
         class => $class,
         name  => $class,
@@ -163,7 +172,9 @@ sub create_class_type_constraint {
 
     $options{name} ||= "__ANON__";
 
-    Moose::Meta::TypeConstraint::Class->new(%options);
+    my $tc = Moose::Meta::TypeConstraint::Class->new(%options);
+    $REGISTRY->add_type_constraint($tc);
+    return $tc;
 }
 
 sub create_role_type_constraint {
@@ -173,6 +184,15 @@ 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");
 
+    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 )
+    }
+
     my %options = (
         role => $role,
         name => $role,
@@ -181,7 +201,9 @@ sub create_role_type_constraint {
 
     $options{name} ||= "__ANON__";
 
-    Moose::Meta::TypeConstraint::Role->new(%options);
+    my $tc = Moose::Meta::TypeConstraint::Role->new(%options);
+    $REGISTRY->add_type_constraint($tc);
+    return $tc;
 }
 
 sub find_or_create_type_constraint {
@@ -323,21 +345,11 @@ sub subtype {
 }
 
 sub class_type {
-    register_type_constraint(
-        create_class_type_constraint(
-            $_[0],
-            ( defined( $_[1] ) ? $_[1] : () ),
-        )
-    );
+    create_class_type_constraint(@_);
 }
 
 sub role_type ($;$) {
-    register_type_constraint(
-        create_role_type_constraint(
-            $_[0],
-            ( defined( $_[1] ) ? $_[1] : () ),
-        )
-    );
+    create_role_type_constraint(@_);
 }
 
 sub maybe_type {