All non-parameterized types now have inlining code

All tests pass, but we really need explicit tests for unoptimized, optimized, and inline cases

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index ed87709..eb4bfd6 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -639,16 +639,30 @@ sub _inline_check_constraint {
 
     my $attr_name = quotemeta($self->name);
 
-    return (
-        'if (!' . $tc . '->(' . $value . ')) {',
-            $self->_inline_throw_error(
-                '"Attribute (' . $attr_name . ') does not pass the type '
-              . 'constraint because: " . '
-              . $tc_obj . '->get_message(' . $value . ')',
-                'data => ' . $value
-            ) . ';',
-        '}',
-    );
+    if ( $self->type_constraint->has_inlined_type_constraint ) {
+        return (
+            'if (! (' . $self->type_constraint->_inline_check($value) . ')) {',
+                $self->_inline_throw_error(
+                    '"Attribute (' . $attr_name . ') does not pass the type '
+                  . 'constraint because: " . '
+                  . $tc_obj . '->get_message(' . $value . ')',
+                    'data => ' . $value
+                ) . ';',
+            '}',
+        );
+    }
+    else {
+        return (
+            'if (!' . $tc . '->(' . $value . ')) {',
+                $self->_inline_throw_error(
+                    '"Attribute (' . $attr_name . ') does not pass the type '
+                  . 'constraint because: " . '
+                  . $tc_obj . '->get_message(' . $value . ')',
+                    'data => ' . $value
+                ) . ';',
+            '}',
+        );
+    }
 }
 
 sub _inline_get_old_value_for_trigger {

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index 0c35333..c783a08 100644 (file)
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -43,6 +43,11 @@ __PACKAGE__->meta->add_attribute('hand_optimized_type_constraint' => (
     predicate => 'has_hand_optimized_type_constraint',
 ));
 
+__PACKAGE__->meta->add_attribute('inlined' => (
+    accessor  => 'inlined',
+    predicate => 'has_inlined_type_constraint',
+));
+
 sub parents {
     my $self;
     $self->parent;
@@ -122,6 +127,15 @@ sub validate {
     }
 }
 
+sub _inline_check {
+    my $self = shift;
+
+    die 'Cannot inline a type constraint check for ' . $self->name
+        unless $self->has_inlined_type_constraint;
+
+    return $self->inlined()->(@_);
+}
+
 sub assert_valid {
     my ($self, $value) = @_;
 

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 50d74ed..59d635c 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -18,6 +18,7 @@ sub where (&);
 sub via (&);
 sub message (&);
 sub optimize_as (&);
+sub inline_as (&);
 
 ## --------------------------------------------------------
 
@@ -286,7 +287,7 @@ sub type {
 
     return _create_type_constraint(
         $name, undef, $p{where}, $p{message},
-        $p{optimize_as}
+        $p{optimize_as}, $p{inline_as},
     );
 }
 
@@ -349,7 +350,7 @@ sub subtype {
 
     return _create_type_constraint(
         $name, $p{as}, $p{where}, $p{message},
-        $p{optimize_as}
+        $p{optimize_as}, $p{inline_as},
     );
 }
 
@@ -419,6 +420,7 @@ sub as { { as => shift }, @_ }
 sub where (&)       { { where       => $_[0] } }
 sub message (&)     { { message     => $_[0] } }
 sub optimize_as (&) { { optimize_as => $_[0] } }
+sub inline_as (&)   { { inline_as   => $_[0] } }
 
 sub from    {@_}
 sub via (&) { $_[0] }
@@ -510,6 +512,7 @@ sub _create_type_constraint ($$$;$$) {
     my $check     = shift;
     my $message   = shift;
     my $optimized = shift;
+    my $inlined   = shift;
 
     my $pkg_defined_in = scalar( caller(1) );
 
@@ -536,6 +539,7 @@ sub _create_type_constraint ($$$;$$) {
         ( $check     ? ( constraint => $check )     : () ),
         ( $message   ? ( message    => $message )   : () ),
         ( $optimized ? ( optimized  => $optimized ) : () ),
+        ( $inlined   ? ( inlined    => $inlined )   : () ),
     );
 
     my $constraint;

diff --git a/lib/Moose/Util/TypeConstraints/Builtins.pm b/lib/Moose/Util/TypeConstraints/Builtins.pm
index d7f90bd..1eab0b6 100644 (file)
--- a/lib/Moose/Util/TypeConstraints/Builtins.pm
+++ b/lib/Moose/Util/TypeConstraints/Builtins.pm
@@ -10,59 +10,88 @@ sub subtype { goto &Moose::Util::TypeConstraints::subtype }
 sub as { goto &Moose::Util::TypeConstraints::as }
 sub where (&) { goto &Moose::Util::TypeConstraints::where }
 sub optimize_as (&) { goto &Moose::Util::TypeConstraints::optimize_as }
+sub inline_as (&) { goto &Moose::Util::TypeConstraints::inline_as }
 
 sub define_builtins {
     my $registry = shift;
 
-    type 'Any'  => where {1};    # meta-type including all
-    subtype 'Item' => as 'Any';  # base-type
+    type 'Any'    # meta-type including all
+        => where {1}
+        => inline_as { '1' };
 
-    subtype 'Undef'   => as 'Item' => where { !defined($_) };
-    subtype 'Defined' => as 'Item' => where { defined($_) };
+    subtype 'Item'  # base-type
+        => as 'Any';
+
+    subtype 'Undef'
+        => as 'Item'
+        => where { !defined($_) }
+        => inline_as { "! defined $_[0]" };
+
+    subtype 'Defined'
+        => as 'Item'
+        => where { defined($_) }
+        => inline_as { "defined $_[0]" };
 
     subtype 'Bool'
         => as 'Item'
-        => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
+        => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' }
+        => inline_as { qq{!defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0'} };
 
     subtype 'Value'
         => as 'Defined'
         => where { !ref($_) }
-        => optimize_as \&_Value;
+        => optimize_as( \&_Value )
+        => inline_as { "defined $_[0] && ! ref $_[0]" };
 
     subtype 'Ref'
         => as 'Defined'
         => where { ref($_) }
-        => optimize_as \&_Ref;
+        => optimize_as( \&_Ref )
+        => inline_as { "ref $_[0]" };
 
     subtype 'Str'
         => as 'Value'
         => where { ref(\$_) eq 'SCALAR' }
-        => optimize_as \&_Str;
+        => optimize_as( \&_Str )
+        => inline_as {
+            return (  qq{defined $_[0]}
+                    . qq{&& (   ref(\\             $_[0] ) eq 'SCALAR'}
+                    . qq{    || ref(\\(my \$value = $_[0])) eq 'SCALAR')} );
+        };
 
     subtype 'Num'
         => as 'Str'
         => where { Scalar::Util::looks_like_number($_) }
-        => optimize_as \&_Num;
+        => optimize_as( \&_Num )
+        => inline_as { "!ref $_[0] && Scalar::Util::looks_like_number($_[0])" };
 
     subtype 'Int'
         => as 'Num'
         => where { "$_" =~ /^-?[0-9]+$/ }
-        => optimize_as \&_Int;
+        => optimize_as( \&_Int )
+        => inline_as {
+            return (  qq{defined $_[0]}
+                    . qq{&& ! ref $_[0]}
+                    . qq{&& ( my \$value = $_[0] ) =~ /\\A-?[0-9]+\\z/} );
+        };
 
     subtype 'CodeRef'
         => as 'Ref'
         => where { ref($_) eq 'CODE' }
-        => optimize_as \&_CodeRef;
+        => optimize_as( \&_CodeRef )
+        => inline_as { qq{ref( $_[0] ) eq 'CODE'} };
 
     subtype 'RegexpRef'
         => as 'Ref'
         => where( \&_RegexpRef )
-        => optimize_as \&_RegexpRef;
+        => optimize_as( \&_RegexpRef )
+        => inline_as { "_RegexpRef( $_[0] )" };
 
     subtype 'GlobRef'
         => as 'Ref'
         => where { ref($_) eq 'GLOB' }
-        => optimize_as \&_GlobRef;
+        => optimize_as( \&_GlobRef )
+        => inline_as { qq{ref( $_[0] ) eq 'GLOB'} };
 
     # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a
     # filehandle
@@ -71,30 +100,42 @@ sub define_builtins {
         => where {
             Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") );
         }
-        => optimize_as \&_FileHandle;
+        => optimize_as( \&_FileHandle )
+        => inline_as {
+            return (  qq{ref( $_[0] ) eq 'GLOB'}
+                    . qq{&& Scalar::Util::openhandle( $_[0] )}
+                    . qq{or blessed( $_[0] ) && $_[0]->isa("IO::Handle")} );
+        };
 
     subtype 'Object'
         => as 'Ref'
         => where { blessed($_) }
-        => optimize_as \&_Object;
+        => optimize_as( \&_Object )
+        => inline_as { "Scalar::Util::blessed( $_[0] )" };
 
     # This type is deprecated.
     subtype 'Role'
         => as 'Object'
         => where { $_->can('does') }
-        => optimize_as \&_Role;
+        => optimize_as( \&_Role );
 
     subtype 'ClassName'
         => as 'Str'
         => where { Class::MOP::is_class_loaded($_) }
-        => optimize_as \&_ClassName;
+        => optimize_as( \&_ClassName )
+        => inline_as { "Class::MOP::is_class_loaded( $_[0] )" };
 
     subtype 'RoleName'
         => as 'ClassName'
         => where {
             (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
         }
-        => optimize_as \&_RoleName;
+        => optimize_as( \&_RoleName )
+        => inline_as {
+            return (  qq{Class::MOP::is_class_loaded( $_[0] )}
+                    . qq{&& ( Class::MOP::class_of( $_[0] ) || return )}
+                    . qq{       ->isa('Moose::Meta::Role')} );
+        };
 
     $registry->add_type_constraint(
         Moose::Meta::TypeConstraint::Parameterizable->new(
@@ -225,7 +266,7 @@ sub _ClassName {
 }
 
 sub _RoleName {
-    ClassName( $_[0] )
+    _ClassName( $_[0] )
         && ( Class::MOP::class_of( $_[0] ) || return )
         ->isa('Moose::Meta::Role');
 }

diff --git a/t/type_constraints/util_std_type_constraints.t b/t/type_constraints/util_std_type_constraints.t
index e183168..a90f2ab 100644 (file)
--- a/t/type_constraints/util_std_type_constraints.t
+++ b/t/type_constraints/util_std_type_constraints.t
@@ -366,13 +366,13 @@ ok(defined RoleName('Quux::Wibble::Role'),      '... RoleName accepts anything w
 # Test $_ is read in XS implementation
 {
   local $_ = qr//;
-  ok(Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef(), '$_ is RegexpRef');
-  ok(!Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef(1), '$_ is not read when param provided');
+  ok(Moose::Util::TypeConstraints::Builtins::_RegexpRef(), '$_ is RegexpRef');
+  ok(!Moose::Util::TypeConstraints::Builtins::_RegexpRef(1), '$_ is not read when param provided');
   $_ = bless qr//, "blessed";
-  ok(Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef(), '$_ is RegexpRef');
+  ok(Moose::Util::TypeConstraints::Builtins::_RegexpRef(), '$_ is RegexpRef');
   $_ = 42;
-  ok(!Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef(), '$_ is not RegexpRef');
-  ok(Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef(qr//), '$_ is not read when param provided');
+  ok(!Moose::Util::TypeConstraints::Builtins::_RegexpRef(), '$_ is not RegexpRef');
+  ok(Moose::Util::TypeConstraints::Builtins::_RegexpRef(qr//), '$_ is not read when param provided');
 }
 
 close($fh) || die "Could not close the filehandle $0 for test";