X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FConstructor.pm;h=b899026d842f534871dc095941e673cc2c843423;hp=ea8af0ffbaa8b11a4d9544ec6231aa0dcfcee6da;hb=3fee6f680e64b907395238b4d7485e600fee4e46;hpb=1ae8a0d7aaaa0627218d5026a013fb70113cce5a diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index ea8af0f..b899026 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -9,6 +9,7 @@ sub generate_constructor_method_inline { my $buildall = $class->_generate_BUILDALL($meta); my $buildargs = $class->_generate_BUILDARGS($meta); my $processattrs = $class->_generate_processattrs($meta, \@attrs); + my @compiled_constraints = map { $_ ? $_->{_compiled_type_constraint} : undef } map { $_->{type_constraint} } @attrs; my $code = <<"..."; sub { @@ -22,6 +23,7 @@ sub generate_constructor_method_inline { ... local $@; + # warn $code; my $res = eval $code; die $@ if $@; $res; @@ -49,11 +51,17 @@ sub _generate_processattrs { } if ($attr->has_type_constraint) { - $code .= "{ - unless (\$attrs[$index]->{type_constraint}->check(\$value)) { - \$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint) + if ($attr->type_constraint->{_compiled_type_constraint}) { + $code .= "unless (\$compiled_constraints[$index](\$value)) {"; + } else { + $code .= "unless (\$attrs[$index]->{type_constraint}->check(\$value)) {"; + } + $code .= " + \$attrs[$index]->verify_type_constraint_error( + '$key', \$_, \$attrs[$index]->type_constraint + ) } - }"; + "; } $code .= "\$instance->{'$key'} = \$value;\n";