From: Dave Rolsky Date: Sun, 10 Apr 2011 03:11:59 +0000 (-0500) Subject: All non-parameterized types now have inlining code X-Git-Tag: 2.0100~85 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4e36cf24ed778c7e59d4ac43a0560df07790b5bd;p=gitmo%2FMoose.git 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 --- 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 --- 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 --- 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 --- 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 --- 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";