X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FClass.pm;h=f4f95592e2da3d7e14c5f11f6e047d8bc7f6fbc6;hb=ae7820b1b884344a7ee90d94b484ca46459eb7b1;hp=b350fe585f2d0694fd57f74c9fa63d7827818ce5;hpb=3eb89f709f04907580b508f821d6be2316fcb65f;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm index b350fe5..f4f9559 100644 --- a/lib/Moose/Meta/TypeConstraint/Class.pm +++ b/lib/Moose/Meta/TypeConstraint/Class.pm @@ -7,7 +7,7 @@ use metaclass; use Scalar::Util 'blessed'; use Moose::Util::TypeConstraints (); -our $VERSION = '1.01'; +our $VERSION = '1.06'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -34,7 +34,7 @@ sub _create_hand_optimized_type_constraint { my $class = $self->class; $self->hand_optimized_type_constraint( sub { - blessed( $_[0] ) && $_[0]->isa($class) + blessed( $_[0] ) && blessed( $_[0] ) ne 'Regexp' && $_[0]->isa($class) } ); } @@ -78,16 +78,17 @@ sub is_a_type_of { sub is_subtype_of { my ($self, $type_or_name_or_class ) = @_; - if ( not ref $type_or_name_or_class ) { - # it might be a class - return 1 if $self->class->isa( $type_or_name_or_class ); - } - my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name_or_class); - return unless defined $type; + if ( not defined $type ) { + if ( not ref $type_or_name_or_class ) { + # it might be a class + return 1 if $self->class->isa( $type_or_name_or_class ); + } + return; + } - if ( $type->isa(__PACKAGE__) ) { + if ( $type->isa(__PACKAGE__) && $type->class ne $self->class) { # if $type_or_name_or_class isn't a class, it might be the TC name of another ::Class type # or it could also just be a type object in this branch return $self->class->isa( $type->class ); @@ -115,7 +116,7 @@ sub get_message { } $value = (defined $value ? overload::StrVal($value) : 'undef'); - return "Validation failed for '" . $self->name . "' failed with value $value (not isa " . $self->class . ")"; + return "Validation failed for '" . $self->name . "' with value $value (not isa " . $self->class . ")"; } 1;