X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FClass.pm;h=6c5d34548f6a9e3670e7a258086ae0b18b25265c;hb=964294c1854e01a6dafe324c4f392acb528150a8;hp=0e8bae5043329402c3d4637b949ed33640a09489;hpb=b612a613c907b32474fd57a2879fe30d3a799317;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm index 0e8bae5..6c5d345 100644 --- a/lib/Moose/Meta/TypeConstraint/Class.pm +++ b/lib/Moose/Meta/TypeConstraint/Class.pm @@ -4,6 +4,7 @@ use strict; use warnings; use metaclass; +use B; use Scalar::Util 'blessed'; use Moose::Util::TypeConstraints (); @@ -13,11 +14,27 @@ __PACKAGE__->meta->add_attribute('class' => ( reader => 'class', )); +my $inliner = sub { + my $self = shift; + my $val = shift; + + return + "Scalar::Util::blessed($val) && $val->isa(" + . B::perlstring( $self->class ) . ')'; +}; + sub new { my ( $class, %args ) = @_; - $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Object'); - my $self = $class->_new(\%args); + $args{parent} + = Moose::Util::TypeConstraints::find_type_constraint('Object'); + + my $class_name = $args{class}; + $args{constraint} = sub { $_[0]->isa($class_name) }; + + $args{inlined} = $inliner; + + my $self = $class->_new( \%args ); $self->_create_hand_optimized_type_constraint; $self->compile_type_constraint();