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 cee7f5e..f48b6cd 100644 (file)
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -9,25 +9,19 @@ use Mouse::Exporter;
 
 Mouse::Exporter->setup_import_methods(
     as_is => [qw(
-        as where message from via
+        as where message optimize_as
+        from via
         type subtype coerce class_type role_type enum
         find_type_constraint
     )],
-
-    _export_to_main => 1,
 );
 
 my %TYPE;
 
-sub as ($) {
-    return(as => $_[0]);
-}
-sub where (&) {
-    return(where => $_[0])
-}
-sub message (&) {
-    return(message => $_[0])
-}
+sub as          ($) { (as => $_[0]) }
+sub where       (&) { (where => $_[0]) }
+sub message     (&) { (message => $_[0]) }
+sub optimize_as (&) { (optimize_as => $_[0]) }
 
 sub from    { @_ }
 sub via (&) { $_[0] }
@@ -38,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) {
@@ -111,6 +101,14 @@ sub _create_type{
     }
 
     $args{name} = $name;
+    my $parent;
+    if($mode eq 'subtype'){
+        $parent = delete $args{as};
+        if(!$parent){
+            $parent = delete $args{name};
+            $name   = '__ANON__';
+        }
+    }
 
     my $package_defined_in = $args{package_defined_in} ||= caller(1);
 
@@ -120,14 +118,11 @@ sub _create_type{
               . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
     }
 
-    $args{constraint} = delete($args{where})       if exists $args{where};
+    $args{constraint} = delete $args{where}        if exists $args{where};
     $args{optimized}  = delete $args{optimized_as} if exists $args{optimized_as};
 
     my $constraint;
     if($mode eq 'subtype'){
-        my $parent = delete($args{as})
-            or confess('A subtype cannot consist solely of a name, it must have a parent');
-
         $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
     }
     else{
@@ -363,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){
@@ -398,12 +402,7 @@ sub find_or_parse_type_constraint {
 }
 
 sub find_or_create_does_type_constraint{
-    my $type = find_or_parse_type_constriant(@_) || 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 {
@@ -418,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;