oops. i forgot to change make_immutable code.
Tokuhiro Matsuno [Wed, 11 Mar 2009 09:00:26 +0000 (18:00 +0900)]
lib/Mouse/Meta/Method/Constructor.pm
lib/Mouse/Util/TypeConstraints.pm
t/900_bug/001_immutable_types.t [new file with mode: 0644]

index 9c8d4f8..ea8af0f 100644 (file)
@@ -42,7 +42,7 @@ sub _generate_processattrs {
             $code .= "if (exists \$args->{'$from'}) {\n";
 
             if ($attr->should_coerce && $attr->type_constraint) {
-                $code .= "my \$value = Mouse::Util::TypeConstraints->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{type_constraint}, \$attrs[$index]->{type_constraint}, \$args->{'$from'});\n";
+                $code .= "my \$value = Mouse::Util::TypeConstraints->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{type_constraint}, \$args->{'$from'});\n";
             }
             else {
                 $code .= "my \$value = \$args->{'$from'};\n";
@@ -77,7 +77,7 @@ sub _generate_processattrs {
                 $code .= "my \$value = ";
 
                 if ($attr->should_coerce && $attr->type_constraint) {
-                    $code .= "Mouse::Util::TypeConstraints->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{type_constraint}, \$attrs[$index]->{type_constraint}, ";
+                    $code .= "Mouse::Util::TypeConstraints->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{type_constraint}, ";
                 }
 
                     if ($attr->has_builder) {
index d4ef508..8f048da 100644 (file)
@@ -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 ) {
diff --git a/t/900_bug/001_immutable_types.t b/t/900_bug/001_immutable_types.t
new file mode 100644 (file)
index 0000000..96a82b5
--- /dev/null
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+use Mouse::Util::TypeConstraints;
+
+subtype 'Foo', where => sub { $_->isa('A') };
+
+{
+    package A;
+    use Mouse;
+    has data => ( is => 'rw', isa => 'Str' );
+}
+
+{
+    package B;
+    use Mouse;
+    has a => ( is => 'rw', isa => 'Foo', coerce => 1 );
+}
+
+isa_ok(B->new(a => A->new()), 'B');
+B->meta->make_immutable;
+isa_ok(B->new(a => A->new()), 'B');
+