X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=2aa712ecf2e312e0b15b3290867ef43275ee43cb;hp=a09d60609d180c0f6a172ae92b86447578e41b3f;hb=d503a4f3aa9eda772309f6c99ccd4dfcdfed059d;hpb=21ee5bbbc20a3366955be77a589206295b5c0f9e diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index a09d606..2aa712e 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -447,12 +447,23 @@ sub _process_options{ my $tc; if(exists $args->{isa}){ - $args->{type_constraint} = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($args->{isa}); + $tc = $args->{type_constraint} = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($args->{isa}); } - elsif(exists $args->{does}){ - $args->{type_constraint} = Mouse::Util::TypeConstraints::find_or_create_does_type_constraint($args->{does}); + + if(exists $args->{does}){ + if(defined $tc){ # both isa and does supplied + my $does_ok = do{ + local $@; + eval{ "$tc"->does($args) }; + }; + if(!$does_ok){ + $class->throw_error("Cannot have both an isa option and a does option because '$tc' does not do '$args->{does}' on attribute ($name)"); + } + } + else { + $tc = $args->{type_constraint} = Mouse::Util::TypeConstraints::find_or_create_does_type_constraint($args->{does}); + } } - $tc = $args->{type_constraint}; if($args->{coerce}){ defined($tc)