Adjusted default 'isa' typeconstraint construction to check if the

[gitmo/Mouse.git] / lib / Mouse / Util / TypeConstraints.pm

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index d4ef508..3ed075d 100644 (file)
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -186,6 +186,7 @@ sub role_type {
 # this is an original method for Mouse
 sub typecast_constraints {
     my($class, $pkg, $types, $value) = @_;
+    Carp::croak("wrong arguments count") unless @_==4;
 
     local $_;
     for my $type ( split /\|/, $types ) {
@@ -275,16 +276,20 @@ sub _build_type_constraint {
             ;
             $code = eval $code_str or Carp::confess($@);
         } else {
-            Carp::confess("Support for parameterized types other than ArrayRef or HashRef is not implemented yet");
+            Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
         }
         $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
     } else {
         $code = $TYPE{ $spec };
         if (! $code) {
+            # is $spec a known role?  If so, constrain with 'does' instead of 'isa'
+            require Mouse::Meta::Role;
+            my $check = Mouse::Meta::Role->_metaclass_cache($spec)? 
+                'does' : 'isa';
             my $code_str = 
                 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
                 "sub {\n" .
-                "    Scalar::Util::blessed(\$_[0]) && \$_[0]->isa('$spec');\n" .
+                "    Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
                 "}"
             ;
             $code = eval $code_str  or Carp::confess($@);