From: Dave Rolsky Date: Fri, 15 Apr 2011 15:40:12 +0000 (-0500) Subject: A name-only subtype now inherits inlining from its parent type X-Git-Tag: 2.0100~68 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7487e61c093e01937e60f35118227afff19d420f;p=gitmo%2FMoose.git A name-only subtype now inherits inlining from its parent type Remove explicit optimized constraint in M::M::TC subclasses --- diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm index 59fa7ec..2347c79 100644 --- a/lib/Moose/Meta/TypeConstraint.pm +++ b/lib/Moose/Meta/TypeConstraint.pm @@ -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, @_ ); } diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm index 6c5d345..ff15e62 100644 --- a/lib/Moose/Meta/TypeConstraint/Class.pm +++ b/lib/Moose/Meta/TypeConstraint/Class.pm @@ -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 ( diff --git a/lib/Moose/Meta/TypeConstraint/DuckType.pm b/lib/Moose/Meta/TypeConstraint/DuckType.pm index 4b3d0c6..8bad0fb 100644 --- a/lib/Moose/Meta/TypeConstraint/DuckType.pm +++ b/lib/Moose/Meta/TypeConstraint/DuckType.pm @@ -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); diff --git a/lib/Moose/Meta/TypeConstraint/Enum.pm b/lib/Moose/Meta/TypeConstraint/Enum.pm index 10e7c1e..b19c59b 100644 --- a/lib/Moose/Meta/TypeConstraint/Enum.pm +++ b/lib/Moose/Meta/TypeConstraint/Enum.pm @@ -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); diff --git a/t/type_constraints/inlining.t b/t/type_constraints/inlining.t index 5e6ebac..af8dd80 100644 --- a/t/type_constraints/inlining.t +++ b/t/type_constraints/inlining.t @@ -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' + ); } {