document the change in the changelogs

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

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 43c5911..fb657ca 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -155,15 +155,30 @@ 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)) {
+        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 )
+        }
+    }
+
     my %options = (
-        class => $class,
-        name  => $class,
+        class              => $class,
+        name               => $class,
+        package_defined_in => $pkg_defined_in,
         %{ $options || {} },
     );
 
     $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,15 +188,30 @@ 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)) {
+        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 )
+        }
+    }
+
     my %options = (
-        role => $role,
-        name => $role,
+        role               => $role,
+        name               => $role,
+        package_defined_in => $pkg_defined_in,
         %{ $options || {} },
     );
 
     $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 {
@@ -214,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 {
@@ -323,21 +353,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 {
@@ -750,6 +770,10 @@ __END__
       from 'Str',
       via { 0+$_ };
 
+  class_type 'DateTimeClass', { class => 'DateTime' };
+
+  role_type 'Barks', { role => 'Some::Library::Role::Barks' };
+
   enum 'RGBColors', [qw(red green blue)];
 
   union 'StringOrArray', [qw( String Array )];
@@ -959,11 +983,29 @@ just a hashref of parameters:
 Creates a new subtype of C<Object> with the name C<$class> and the
 metaclass L<Moose::Meta::TypeConstraint::Class>.
 
+  # Create a type called 'Box' which tests for objects which ->isa('Box')
+  class_type 'Box';
+
+By default, the name of the type and the name of the class are the same, but
+you can specify both separately.
+
+  # Create a type called 'Box' which tests for objects which ->isa('ObjectLibrary::Box');
+  class_type 'Box', { class => 'ObjectLibrary::Box' };
+
 =item B<role_type ($role, ?$options)>
 
 Creates a C<Role> type constraint with the name C<$role> and the
 metaclass L<Moose::Meta::TypeConstraint::Role>.
 
+  # Create a type called 'Walks' which tests for objects which ->does('Walks')
+  role_type 'Walks';
+
+By default, the name of the type and the name of the role are the same, but
+you can specify both separately.
+
+  # Create a type called 'Walks' which tests for objects which ->does('MooseX::Role::Walks');
+  role_type 'Walks', { role => 'MooseX::Role::Walks' };
+
 =item B<maybe_type ($type)>
 
 Creates a type constraint for either C<undef> or something of the