A name-only subtype now inherits inlining from its parent type
Dave Rolsky [Fri, 15 Apr 2011 15:40:12 +0000 (10:40 -0500)]
Remove explicit optimized constraint in M::M::TC subclasses

lib/Moose/Meta/TypeConstraint.pm
lib/Moose/Meta/TypeConstraint/Class.pm
lib/Moose/Meta/TypeConstraint/DuckType.pm
lib/Moose/Meta/TypeConstraint/Enum.pm
t/type_constraints/inlining.t

index 59fa7ec..2347c79 100644 (file)
@@ -44,8 +44,9 @@ __PACKAGE__->meta->add_attribute('hand_optimized_type_constraint' => (
 ));
 
 __PACKAGE__->meta->add_attribute('inlined' => (
+    init_arg  => 'inlined',
     accessor  => 'inlined',
-    predicate => 'has_inlined_type_constraint',
+    predicate => '_has_inlined_type_constraint',
 ));
 
 sub parents {
@@ -127,6 +128,16 @@ sub validate {
     }
 }
 
+sub has_inlined_type_constraint {
+    my $self = shift;
+
+    if ( $self->has_parent && $self->constraint eq $null_constraint ) {
+        return $self->parent->has_inlined_type_constraint;
+    }
+
+    return $self->_has_inlined_type_constraint;
+}
+
 sub _inline_check {
     my $self = shift;
 
@@ -135,6 +146,10 @@ sub _inline_check {
         Moose->throw_error( 'Cannot inline a type constraint check for ' . $self->name );
     }
 
+    if ( $self->has_parent && $self->constraint eq $null_constraint ) {
+        return $self->parent->_inline_check(@_);
+    }
+
     return $self->inlined->( $self, @_ );
 }
 
index 6c5d345..ff15e62 100644 (file)
@@ -36,22 +36,11 @@ sub new {
 
     my $self = $class->_new( \%args );
 
-    $self->_create_hand_optimized_type_constraint;
     $self->compile_type_constraint();
 
     return $self;
 }
 
-sub _create_hand_optimized_type_constraint {
-    my $self = shift;
-    my $class = $self->class;
-    $self->hand_optimized_type_constraint(
-        sub {
-            blessed( $_[0] ) && $_[0]->isa($class)
-        }
-    );
-}
-
 sub parents {
     my $self = shift;
     return (
index 4b3d0c6..8bad0fb 100644 (file)
@@ -83,20 +83,6 @@ sub constraint {
     };
 }
 
-sub _compile_hand_optimized_type_constraint {
-    my $self  = shift;
-
-    my @methods = @{ $self->methods };
-
-    sub {
-        my $obj = shift;
-
-        return blessed($obj)
-            && blessed($obj) ne 'Regexp'
-            && all { $obj->can($_) } @methods;
-    };
-}
-
 sub create_child_type {
     my ($self, @args) = @_;
     return Moose::Meta::TypeConstraint->new(@args, parent => $self);
index 10e7c1e..b19c59b 100644 (file)
@@ -94,14 +94,6 @@ sub constraint {
     return sub { exists $values{$_[0]} };
 }
 
-sub _compile_hand_optimized_type_constraint {
-    my $self  = shift;
-
-    my %values = map { $_ => undef } @{ $self->values };
-
-    sub { defined($_[0]) && !ref($_[0]) && exists $values{$_[0]} };
-}
-
 sub create_child_type {
     my ($self, @args) = @_;
     return Moose::Meta::TypeConstraint->new(@args, parent => $self);
index 5e6ebac..af8dd80 100644 (file)
@@ -75,10 +75,7 @@ subtype 'ArrayOfInlinable',
 
 subtype 'ArrayOfNotInlinable',
     as 'ArrayRef[NotInlinable]';
-
 {
-    local $TODO = 'A subtype of a Parameterized type should not be a Parameterizable type';
-
     my $aofi = Moose::Util::TypeConstraints::find_or_create_type_constraint(
         'ArrayOfInlinable');
 
@@ -86,6 +83,20 @@ subtype 'ArrayOfNotInlinable',
         $aofi->has_inlined_type_constraint,
         'ArrayOfInlinable returns true for has_inlined_type_constraint'
     );
+
+    is(
+        $aofi->_inline_check('$foo'),
+        q{ref $foo eq 'ARRAY' && &List::MoreUtils::all( sub { defined $_ && ! ref $_ && $_ !~ /Q/ }, @{$foo} )},
+        'got expected inline code for ArrayOfInlinable constraint'
+    );
+
+    my $aofni = Moose::Util::TypeConstraints::find_or_create_type_constraint(
+        'ArrayOfNotInlinable');
+
+    ok(
+        !$aofni->has_inlined_type_constraint,
+        'ArrayOfNotInlinable returns false for has_inlined_type_constraint'
+    );
 }
 
 {