built-in type constraints in XS

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

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index 4d2954e..f48b6cd 100644 (file)
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -14,8 +14,6 @@ Mouse::Exporter->setup_import_methods(
         type subtype coerce class_type role_type enum
         find_type_constraint
     )],
-
-    _export_to_main => 1,
 );
 
 my %TYPE;
@@ -34,32 +32,28 @@ BEGIN {
         Item       => undef, # null check
         Maybe      => undef, # null check
 
-        Bool       => sub { $_[0] ? $_[0] eq '1' : 1 },
-        Undef      => sub { !defined($_[0]) },
-        Defined    => sub { defined($_[0]) },
-        Value      => sub { defined($_[0]) && !ref($_[0]) },
-        Num        => sub { !ref($_[0]) && looks_like_number($_[0]) },
-        Int        => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
-        Str        => sub { defined($_[0]) && !ref($_[0]) },
-        Ref        => sub { ref($_[0]) },
-
-        ScalarRef  => sub { ref($_[0]) eq 'SCALAR' },
-        ArrayRef   => sub { ref($_[0]) eq 'ARRAY'  },
-        HashRef    => sub { ref($_[0]) eq 'HASH'   },
-        CodeRef    => sub { ref($_[0]) eq 'CODE'   },
-        RegexpRef  => sub { ref($_[0]) eq 'Regexp' },
-        GlobRef    => sub { ref($_[0]) eq 'GLOB'   },
-
-        FileHandle => sub {
-            ref($_[0]) eq 'GLOB' && openhandle($_[0])
-            or
-            blessed($_[0]) && $_[0]->isa("IO::Handle")
-        },
-
-        Object     => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
-
-        ClassName  => sub { Mouse::Util::is_class_loaded($_[0]) },
-        RoleName   => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
+        Bool       => \&Bool,
+        Undef      => \&Undef,
+        Defined    => \&Defined,
+        Value      => \&Value,
+        Num        => \&Num,
+        Int        => \&Int,
+        Str        => \&Str,
+        Ref        => \&Ref,
+
+        ScalarRef  => \&ScalarRef,
+        ArrayRef   => \&ArrayRef,
+        HashRef    => \&HashRef,
+        CodeRef    => \&CodeRef,
+        RegexpRef  => \&RegexpRef,
+        GlobRef    => \&GlobRef,
+
+        FileHandle => \&FileHandle,
+
+        Object     => \&Object,
+
+        ClassName  => \&ClassName,
+        RoleName   => \&RoleName,
     );
 
     while (my ($name, $code) = each %builtins) {
@@ -364,7 +358,16 @@ sub _parse_type{
         }
     }
     if($i - $start){
-        push @list, _find_or_create_regular_type(substr $spec, $start, $i - $start);
+        my $type = _find_or_create_regular_type( substr $spec, $start, $i - $start );
+
+        if(defined $type){
+            push @list, $type;
+        }
+        elsif($start != 0) {
+            # RT #50421
+            # create a new class type
+            push @list, class_type( substr $spec, $start, $i - $start );
+        }
     }
 
     if(@list == 0){
@@ -399,12 +402,7 @@ sub find_or_parse_type_constraint {
 }
 
 sub find_or_create_does_type_constraint{
-    my $type = find_or_parse_type_constraint(@_) || role_type(@_);
-
-    if($type->{type} && $type->{type} ne 'Role'){
-        Carp::cluck("$type is not a role type");
-    }
-    return $type;
+    return find_or_parse_type_constraint(@_) || role_type(@_);
 }
 
 sub find_or_create_isa_type_constraint {
@@ -419,6 +417,10 @@ __END__
 
 Mouse::Util::TypeConstraints - Type constraint system for Mouse
 
+=head1 VERSION
+
+This document describes Mouse version 0.40
+
 =head2 SYNOPSIS
 
   use Mouse::Util::TypeConstraints;