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=a948919dd5c07561556668912cfa5383567657bd;hpb=e3d94ac0990080399851812a76928c893c3cd4fa;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm index a948919..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 = '0.82'; +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; @@ -189,9 +190,7 @@ with accidentally autovivified type constraints. =head1 BUGS -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +See L for details on reporting bugs. =head1 AUTHOR @@ -199,7 +198,7 @@ Yuval Kogman Enothingmuch@cpan.orgE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L