Move features used only for testing to t/lib/Test/Mouse.pm

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

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index 8cbcc26..9755115 100644 (file)
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -33,8 +33,7 @@ sub from    { @_ }
 sub via (&) { $_[0] }
 
 BEGIN {
-    no warnings 'uninitialized';
-    %TYPE = (
+    my %builtins = (
         Any        => sub { 1 },
         Item       => sub { 1 },
 
@@ -63,20 +62,23 @@ BEGIN {
         Object     => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
 
         ClassName  => sub { Mouse::Util::is_class_loaded($_[0]) },
-        RoleName   => sub { (Mouse::Util::class_of($_[0]) || return 0)->isa('Mouse::Meta::Role') },
+        RoleName   => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
     );
-    while (my ($name, $code) = each %TYPE) {
+
+    while (my ($name, $code) = each %builtins) {
         $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
             name                      => $name,
             _compiled_type_constraint => $code,
         );
+        $TYPE_SOURCE{$name} = __PACKAGE__;
     }
 
     sub optimized_constraints { \%TYPE }
-    my @TYPE_KEYS = keys %TYPE;
-    sub list_all_builtin_type_constraints { @TYPE_KEYS }
 
-    @TYPE_SOURCE{@TYPE_KEYS} = (__PACKAGE__) x @TYPE_KEYS;
+    my @builtins = keys %TYPE;
+    sub list_all_builtin_type_constraints { @builtins }
+
+    sub list_all_type_constraints         { keys %TYPE }
 }
 
 sub type {
@@ -105,26 +107,24 @@ sub type {
     if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
     }
+
     my $constraint = $conf{where} || do {
         my $as = delete $conf{as} || 'Any';
-        if (! exists $TYPE{$as}) {
-            $TYPE{$as} = _build_type_constraint($as);
-        }
-        $TYPE{$as};
+        ($TYPE{$as} ||= _build_type_constraint($as))->{_compiled_type_constraint};
     };
 
-    $TYPE_SOURCE{$name} = $pkg;
-    $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
-        name => $name,
+    my $tc = Mouse::Meta::TypeConstraint->new(
+        name                      => $name,
         _compiled_type_constraint => sub {
             local $_ = $_[0];
-            if (ref $constraint eq 'CODE') {
-                $constraint->($_[0])
-            } else {
-                $constraint->check($_[0])
-            }
-        }
+            return &{$constraint};
+        },
     );
+
+    $TYPE_SOURCE{$name} = $pkg;
+    $TYPE{$name}        = $tc;
+
+    return $tc;
 }
 
 sub subtype {
@@ -150,31 +150,34 @@ sub subtype {
 
     my $pkg = caller;
 
-
     if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
     }
-    my $constraint = delete $conf{where};
-    my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any');
 
-    $TYPE_SOURCE{$name} = $pkg;
-    $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
+    my $constraint    = delete $conf{where};
+    my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any')
+        ->{_compiled_type_constraint};
+
+    my $tc = Mouse::Meta::TypeConstraint->new(
         name => $name,
         _compiled_type_constraint => (
             $constraint ? 
             sub {
                 local $_ = $_[0];
-                $as_constraint->check($_[0]) && $constraint->($_[0])
+                $as_constraint->($_[0]) && $constraint->($_[0])
             } :
             sub {
                 local $_ = $_[0];
-                $as_constraint->check($_[0]);
+                $as_constraint->($_[0]);
             }
         ),
-        %conf
+        %conf,
     );
 
-    return $name;
+    $TYPE_SOURCE{$name} = $pkg;
+    $TYPE{$name}        = $tc;
+
+    return $tc;
 }
 
 sub coerce {
@@ -348,8 +351,13 @@ sub _build_type_constraint {
 }
 
 sub find_type_constraint {
-    my $type_constraint = shift;
-    return $TYPE{$type_constraint};
+    my($type) = @_;
+    if(blessed($type) && $type->isa('Mouse::Meta::TypeConstraint')){
+        return $type;
+    }
+    else{
+        return $TYPE{$type};
+    }
 }
 
 sub find_or_create_isa_type_constraint {