From: Yuval Kogman Date: Sun, 13 Jan 2008 23:51:35 +0000 (+0000) Subject: faster type constraints X-Git-Tag: 0_35~20 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=42bc21a45d17c5ca41e63241ee70f4eacea5230c;p=gitmo%2FMoose.git faster type constraints --- diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 104151d..9a7545e 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -277,7 +277,7 @@ sub set_value { if ($self->should_coerce) { $value = $type_constraint->coerce($value); } - defined($type_constraint->_compiled_type_constraint->($value)) + $type_constraint->_compiled_type_constraint->($value) || confess "Attribute ($attr_name) does not pass the type constraint (" . $type_constraint->name . ") with " diff --git a/lib/Moose/Meta/TypeCoercion.pm b/lib/Moose/Meta/TypeCoercion.pm index 36acba4..7ace8e7 100644 --- a/lib/Moose/Meta/TypeCoercion.pm +++ b/lib/Moose/Meta/TypeCoercion.pm @@ -55,7 +55,7 @@ sub compile_type_coercion { my $thing = shift; foreach my $coercion (@coercions) { my ($constraint, $converter) = @$coercion; - if (defined $constraint->($thing)) { + if ($constraint->($thing)) { local $_ = $thing; return $converter->($thing); } @@ -154,4 +154,4 @@ L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm index 691337c..b37ee8a 100644 --- a/lib/Moose/Meta/TypeConstraint.pm +++ b/lib/Moose/Meta/TypeConstraint.pm @@ -58,7 +58,7 @@ sub new { } sub coerce { ((shift)->coercion || confess "Cannot coerce without a type coercion")->coerce(@_) } -sub check { $_[0]->_compiled_type_constraint->($_[1]) } +sub check { $_[0]->_compiled_type_constraint->($_[1]) ? 1 : undef } sub validate { my ($self, $value) = @_; if ($self->_compiled_type_constraint->($value)) { @@ -124,11 +124,9 @@ sub _compile_hand_optimized_type_constraint { my $type_constraint = $self->hand_optimized_type_constraint; - return sub { - confess unless ref $type_constraint; - return undef unless $type_constraint->($_[0]); - return 1; - }; + confess unless ref $type_constraint; + + return $type_constraint; } sub _compile_subtype { diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 5af8dc5..2d6a438 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -98,8 +98,8 @@ sub export_type_constraints_as_functions { my $pkg = caller(); no strict 'refs'; foreach my $constraint (keys %{$REGISTRY->type_constraints}) { - *{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint) - ->_compiled_type_constraint; + my $tc = $REGISTRY->get_type_constraint($constraint)->_compiled_type_constraint; + *{"${pkg}::${constraint}"} = sub { $tc->($_[0]) ? 1 : undef }; } } diff --git a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm index 47ea4e9..0576a14 100644 --- a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm +++ b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm @@ -24,12 +24,15 @@ sub Num { !ref($_[0]) && looks_like_number($_[0]) } sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ } -sub ScalarRef { ref($_[0]) eq 'SCALAR' } -sub ArrayRef { ref($_[0]) eq 'ARRAY' } -sub HashRef { ref($_[0]) eq 'HASH' } -sub CodeRef { ref($_[0]) eq 'CODE' } -sub RegexpRef { ref($_[0]) eq 'Regexp' } -sub GlobRef { ref($_[0]) eq 'GLOB' } +{ + no warnings 'uninitialized'; + sub ScalarRef { ref($_[0]) eq 'SCALAR' } + sub ArrayRef { ref($_[0]) eq 'ARRAY' } + sub HashRef { ref($_[0]) eq 'HASH' } + sub CodeRef { ref($_[0]) eq 'CODE' } + sub RegexpRef { ref($_[0]) eq 'Regexp' } + sub GlobRef { ref($_[0]) eq 'GLOB' } +} sub FileHandle { ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]) }