From: Tokuhiro Matsuno Date: Wed, 11 Mar 2009 09:00:26 +0000 (+0900) Subject: oops. i forgot to change make_immutable code. X-Git-Tag: 0.20~33 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=86b99892e77319cf2f046f4563e0717f4005851d oops. i forgot to change make_immutable code. --- diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index 9c8d4f8..ea8af0f 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -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) { diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index d4ef508..8f048da 100644 --- 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 ) { diff --git a/t/900_bug/001_immutable_types.t b/t/900_bug/001_immutable_types.t new file mode 100644 index 0000000..96a82b5 --- /dev/null +++ b/t/900_bug/001_immutable_types.t @@ -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'); +