X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FTypeConstraint.pm;h=2dcba4353b4d653682b7d594d775370fdc628ace;hp=6bb7e2171824740b3b725fff58014349b4b457cc;hb=145d67894adb93b4aa067e88b914fc83a5a3533c;hpb=98278c01eed05099a997aed1ba47bc545626288d diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index 6bb7e21..2dcba43 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -1,6 +1,5 @@ package Mouse::Meta::TypeConstraint; use Mouse::Util qw(:meta); # enables strict and warnings -use Scalar::Util (); sub new { my $class = shift; @@ -8,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 @@ -72,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}; @@ -90,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; } @@ -144,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->(@_); } @@ -172,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 @@ -222,7 +215,7 @@ sub assert_valid { } sub _as_string { $_[0]->name } # overload "" -sub _identity { Scalar::Util::refaddr($_[0]) } # overload 0+ +sub _identity; # overload 0+ sub _unite { # overload infix:<|> my($lhs, $rhs) = @_;