X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint.pm;h=c5f5750efa186c2a80b5f9badec24d280372ff6b;hb=436d7a280efd1a65df197acefcc61b590a171f5d;hp=0f3cf02de706047c2a2965904ad82e0e8aa73707;hpb=0aca6c894339607ab07bc40a508ab47129f0f1ec;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm index 0f3cf02..c5f5750 100644 --- a/lib/Moose/Meta/TypeConstraint.pm +++ b/lib/Moose/Meta/TypeConstraint.pm @@ -9,10 +9,11 @@ use overload '""' => sub { shift->name }, # stringify to tc name fallback => 1; use Scalar::Util qw(blessed refaddr); +use Sub::Name qw(subname); use base qw(Class::MOP::Object); -our $VERSION = '0.74'; +our $VERSION = '0.77'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -82,6 +83,8 @@ sub coerce { Moose->throw_error("Cannot coerce without a type coercion"); } + return $_[0] if $self->check($_[0]); + return $coercion->coerce(@_); } @@ -108,9 +111,9 @@ sub get_message { return $msg->($value); } else { - $value = (defined $value ? overload::StrVal($value) : 'undef'); + $value = (defined $value ? overload::StrVal($value) : 'undef'); return "Validation failed for '" . $self->name . "' failed with value $value"; - } + } } ## type predicates ... @@ -232,7 +235,7 @@ sub _compile_subtype { if ( $check == $null_constraint ) { return $optimized_parent; } else { - return Class::MOP::subname($self->name, sub { + return subname($self->name, sub { return undef unless $optimized_parent->($_[0]); my (@args) = @_; local $_ = $args[0]; @@ -243,7 +246,7 @@ sub _compile_subtype { # general case, check all the constraints, from the first parent to ourselves my @checks = @parents; push @checks, $check if $check != $null_constraint; - return Class::MOP::subname($self->name => sub { + return subname($self->name => sub { my (@args) = @_; local $_ = $args[0]; foreach my $check (@checks) { @@ -259,7 +262,7 @@ sub _compile_type { return $check if $check == $null_constraint; # Item, Any - return Class::MOP::subname($self->name => sub { + return subname($self->name => sub { my (@args) = @_; local $_ = $args[0]; $check->(@args);