From: Fuji, Goro Date: Mon, 27 Sep 2010 03:07:48 +0000 (+0900) Subject: Tweaks X-Git-Tag: 0.75~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4b58033d236a709a6b3ce901f29f601801329476;p=gitmo%2FMouse.git Tweaks --- diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm index 2c5920a..5ed42f3 100644 --- a/lib/Mouse/Meta/Method/Accessor.pm +++ b/lib/Mouse/Meta/Method/Accessor.pm @@ -95,7 +95,6 @@ sub _generate_accessor_any{ } elsif(defined $constraint){ $accessor .= "my \$tmp = $value;\n"; - $accessor .= "\$compiled_type_constraint->(\$tmp)"; $accessor .= " || \$attribute->_throw_type_constraint_error(\$tmp, \$constraint);\n"; $accessor .= "$slot = \$tmp;\n"; diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index f2319fa..6813d32 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -7,7 +7,7 @@ sub new { $args{name} = '__ANON__' if !defined $args{name}; - if($args{parent}) { + if(defined $args{parent}) { %args = (%{$args{parent}}, %args); # a child type must not inherit 'compiled_type_constraint' # and 'hand_optimized_type_constraint' from the parent @@ -71,6 +71,11 @@ sub compile_type_constraint; sub _add_type_coercions { # ($self, @pairs) my $self = shift; + if(exists $self->{type_constraints}){ # union type + $self->throw_error( + "Cannot add additional type coercions to Union types '$self'"); + } + my $coercions = ($self->{coercion_map} ||= []); my %has = map{ $_->[0] => undef } @{$coercions}; @@ -89,14 +94,7 @@ sub _add_type_coercions { # ($self, @pairs) push @{$coercions}, [ $type => $action ]; } - # compile - if(exists $self->{type_constraints}){ # union type - $self->throw_error( - "Cannot add additional type coercions to Union types"); - } - else{ - $self->_compile_type_coercion(); - } + $self->_compile_type_coercion(); return; } @@ -143,14 +141,10 @@ sub _compile_union_type_coercion { sub coerce { my $self = shift; - - my $coercion = $self->_compiled_type_coercion; - if(!$coercion){ - $self->throw_error("Cannot coerce without a type coercion"); - } - return $_[0] if $self->check(@_); + my $coercion = $self->{_compiled_type_coercion} + or $self->throw_error("Cannot coerce without a type coercion"); return $coercion->(@_); } @@ -171,7 +165,7 @@ sub get_message { } } -sub is_a_type_of{ +sub is_a_type_of { my($self, $other) = @_; # ->is_a_type_of('__ANON__') is always false diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index a5eab76..80756cd 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -144,14 +144,17 @@ sub Undef { !defined($_[0]) } sub Defined { defined($_[0]) } sub Value { defined($_[0]) && !ref($_[0]) } sub Num { looks_like_number($_[0]) } -sub Int { - my($value) = @_; - looks_like_number($value) && $value =~ /\A [+-]? [0-9]+ \z/xms; -} sub Str { + # We need to use a copy here to flatten MAGICs, for instance as in + # Str( substr($_, 0, 42) ). my($value) = @_; return defined($value) && ref(\$value) eq 'SCALAR'; } +sub Int { + # We need to use a copy here to save the original internal SV flags. + my($value) = @_; + return defined($value) && $value =~ /\A -? [0-9]+ \z/xms; +} sub Ref { ref($_[0]) } sub ScalarRef {