my $slot_access = $self->_inline_access($inv, $attr_name);
my $value_name = $self->_value_needs_copy ? '$val' : '$_[1]';
+ my $type_constraint_obj = $attr->type_constraint;
+ my $type_constraint_name = $type_constraint_obj && $type_constraint_obj->name;
+
my $code = 'sub { ' . "\n"
. $self->_inline_pre_body(@_) . "\n"
. 'if (scalar(@_) == 2) {' . "\n"
# NOTE:
# set up the environment
my $type_constraint = $attr->type_constraint
- ? $attr->type_constraint->_compiled_type_constraint
+ ? (
+ $attr->type_constraint->has_hand_optimized_type_constraint
+ ? $attr->type_constraint->hand_optimized_type_constraint
+ : $attr->type_constraint->_compiled_type_constraint
+ )
: undef;
my $sub = eval $code;
# This sprintf is insanely annoying, we should
# fix it someday - SL
return sprintf <<'EOF', $value, $value, $value, $value, $value, $value, $value
-defined($type_constraint->(%s))
- || confess "Attribute (" . $attr->name . ") does not pass the type constraint ("
- . $attr->type_constraint->name . ") with "
+$type_constraint->(%s)
+ || confess "Attribute (" . $attr_name . ") does not pass the type constraint ("
+ . $type_constraint_name . ") with "
. (defined(%s) ? (Scalar::Util::blessed(%s) && overload::Overloaded(%s) ? overload::StrVal(%s) : %s) : "undef")
if defined(%s);
EOF
' confess(Scalar::Util::blessed('.$inv.')." does not support builder method '.
'\'".$attr->builder."\' for attribute \'" . $attr->name . "\'");'. "\n }";
}
- $code .= ' $default = $attr->type_constraint->coerce($default);'."\n" if $attr->should_coerce;
- $code .= ' (defined($type_constraint->($default)))' .
- ' || confess "Attribute (" . $attr->name . ") does not pass the type constraint ("' .
- ' . $attr->type_constraint->name . ") with " . (defined($default) ? (Scalar::Util::blessed($default) && overload::Overloaded($default) ? overload::StrVal($default) : $default) : "undef")' .
+ $code .= ' $default = $type_constraint_obj->coerce($default);'."\n" if $attr->should_coerce;
+ $code .= ' ($type_constraint->($default))' .
+ ' || confess "Attribute (" . $attr_name . ") does not pass the type constraint ("' .
+ ' . $type_constraint_name . ") with " . (defined($default) ? (Scalar::Util::blessed($default) && overload::Overloaded($default) ? overload::StrVal($default) : $default) : "undef")' .
' if defined($default);' . "\n" .
' ' . $slot_access . ' = $default; ' . "\n";
}
# to be picked up in the eval
my $attrs = $self->attributes;
+ my @type_constraints = map { $_->type_constraint } @$attrs;
+
$code = eval $source;
confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@;
}
push @source => ('my $val = $params{\'' . $attr->init_arg . '\'};');
if ($is_moose && $attr->has_type_constraint) {
- push @source => ('my $type_constraint = $attrs->[' . $index . ']->type_constraint;');
+ push @source => ('my $type_constraint = $type_constraints[' . $index . '];');
if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
push @source => $self->_generate_type_coercion($attr, '$type_constraint', '$val', '$val');
push @source => ('my $val = ' . $default . ';');
push @source => $self->_generate_type_constraint_check(
$attr,
- ('$attrs->[' . $index . ']->type_constraint'),
+ ('$type_constraints[' . $index . ']'),
'$val'
) if ($is_moose && $attr->has_type_constraint);
push @source => $self->_generate_slot_assignment($attr, $default);
push @source => ('my $val = $params{\'' . $attr->init_arg . '\'};');
if ($is_moose && $attr->has_type_constraint) {
- push @source => ('my $type_constraint = $attrs->[' . $index . ']->type_constraint;');
+ push @source => ('my $type_constraint = $type_constraints[' . $index . '];');
if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
push @source => $self->_generate_type_coercion($attr, '$type_constraint', '$val', '$val');