From: Fuji, Goro Date: Tue, 5 Oct 2010 06:24:34 +0000 (+0900) Subject: Resolve RT #61852, thanks to Vincent Pit X-Git-Tag: 0.78~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=7e030e4515771aa9117a8d1ca04d6afe028b7a9b Resolve RT #61852, thanks to Vincent Pit --- diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index b703f32..75d4e71 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -13,6 +13,9 @@ sub new { # and 'hand_optimized_type_constraint' from the parent delete $args{compiled_type_constraint}; delete $args{hand_optimized_type_constraint}; + if(defined(my $parent_tp = $args{parent}{type_parameter})) { + delete $args{type_parameter} if $parent_tp == $args{type_parameter}; + } } my $check; @@ -189,7 +192,7 @@ sub is_a_type_of { } # See also Moose::Meta::TypeConstraint::Parameterizable -sub parameterize{ +sub parameterize { my($self, $param, $name) = @_; if(!ref $param){ diff --git a/t/900_mouse_bugs/011_RT61852.t b/t/900_mouse_bugs/011_RT61852.t new file mode 100644 index 0000000..1ce0abe --- /dev/null +++ b/t/900_mouse_bugs/011_RT61852.t @@ -0,0 +1,31 @@ +#!perl +# https://rt.cpan.org/Public/Bug/Display.html?id=61852 +use strict; +use warnings; +use Test::More; +{ + package X; + use Mouse; + use Mouse::Util::TypeConstraints; + + subtype 'List' + => as 'ArrayRef[Any]' + => where { + foreach my $item(@{$_}) { + defined($item) or return 0; + } + return 1; + }; + + has 'list' => ( + is => 'ro', + isa => 'List', + ); +} + +eval { X->new(list => [ 1, 2, 3 ]) }; +is $@, ''; + +eval { X->new(list => [ 1, undef, 3 ]) }; +like $@, qr/Validation[ ]failed[ ]for[ ]'List'/xms; +done_testing;