use strict;
use warnings;
-our $VERSION = '1.19';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
use Moose::Role;
requires qw( _adds_members );
return unless $self->_tc_member_type_can_coerce;
return (
- '(' . $self->_new_members . ') = map { $member_tc_obj->coerce($_) }',
+ '(' . $self->_new_members . ') = map { $member_coercion->($_) }',
$self->_new_members . ';',
);
}
return;
}
-sub _value_needs_copy {
+sub _writer_value_needs_copy {
my $self = shift;
return $self->_constraint_must_be_checked
sub _inline_tc_code {
my $self = shift;
- my ($potential_value) = @_;
+ my ($value, $tc, $coercion, $message, $is_lazy) = @_;
return unless $self->_constraint_must_be_checked;
}
else {
return (
- $self->_inline_check_coercion($potential_value),
- $self->_inline_check_constraint($potential_value),
+ $self->_inline_check_coercion($value, $tc, $coercion, $is_lazy),
+ $self->_inline_check_constraint($value, $tc, $message, $is_lazy),
);
}
}
# constraint, so we need to check the whole value, not just the members.
return 1
if $self->_is_root_type( $tc->parent )
- && $tc->isa('Moose::Meta::TypeConstraint::Parameterized');
+ && ( $tc->isa('Moose::Meta::TypeConstraint::Parameterized')
+ || $tc->isa('Type::Constraint::Parameterized') );
return 0;
}
my $attr_name = $self->associated_attribute->name;
+ my $check
+ = $self->_tc_member_type->can_be_inlined
+ ? '! (' . $self->_tc_member_type->_inline_check('$new_val') . ')'
+ : ' !$member_tc->($new_val) ';
+
return (
- 'for (' . $new_value . ') {',
- 'if (!$member_tc->($_)) {',
+ 'for my $new_val (' . $new_value . ') {',
+ "if ($check) {",
$self->_inline_throw_error(
'"A new member value for ' . $attr_name
- . ' does not pass its type constraint because: "'
- . ' . $member_tc->get_message($_)',
- 'data => $_',
+ . ' does not pass its type constraint because: "' . ' . '
+ . 'do { local $_ = $new_val; $member_message->($new_val) }',
+ 'data => $new_val',
) . ';',
'}',
'}',
return unless $attr->has_trigger;
return (
- 'my ' . $old . ' = ' . $self->_inline_has($instance),
- '? ' . $self->_inline_copy_old_value($self->_inline_get($instance)),
+ 'my ' . $old . ' = ' . $self->_has_value($instance),
+ '? ' . $self->_copy_old_value($self->_get_value($instance)),
': ();',
);
}
return $env unless $member_tc;
- $env->{'$member_tc_obj'} = \($member_tc);
-
$env->{'$member_tc'} = \( $member_tc->_compiled_type_constraint );
+ $env->{'$member_coercion'} = \(
+ $member_tc->coercion->_compiled_type_coercion
+ ) if $member_tc->has_coercion;
+ $env->{'$member_message'} = \(
+ $member_tc->has_message
+ ? $member_tc->message
+ : $member_tc->_default_message
+ );
+
+ my $tc_env = $member_tc->inline_environment();
+
+ $env = { %{$env}, %{$tc_env} };
return $env;
};