cowardly refuse to inline mutable coercions - see also RT#93345

lib/Type/Coercion.pm

@@ -300,6 +300,9 @@ sub _build_compiled_coercion
 sub can_be_inlined
 {
 	my $self = shift;
+
+	return unless $self->frozen;
+
 	return
 		if $self->has_type_constraint
 		&& !$self->type_constraint->can_be_inlined;

lib/Type/Coercion/FromMoose.pm

@@ -63,6 +63,11 @@ sub _build_moose_coercion
 	$self->SUPER::_build_moose_coercion(@_);
 }
 
+sub can_be_inlined
+{
+	0;
+}
+
 1;
 
 __END__

lib/Type/Coercion/Union.pm

@@ -70,6 +70,21 @@ sub _build_moose_coercion
 	return $r;
 }
 
+sub can_be_inlined
+{
+	my $self = shift;
+
+	Types::TypeTiny::TypeTiny->assert_valid(my $type = $self->type_constraint);
+
+	for my $tc (@$type)
+	{
+		next unless $tc->has_coercion;
+		return !!0 unless $tc->coercion->can_be_inlined;
+	}
+
+	!!1;
+}
+
 1;
 
 __END__

t/20-unit/Type-Coercion-Union/basic.t

@@ -31,14 +31,14 @@ use Types::Standard -types;
 use Type::Utils;
 
 my $RoundedInteger = declare RoundedInteger => as Int;
-$RoundedInteger->coercion->add_type_coercions(Num, 'int($_)');
+$RoundedInteger->coercion->add_type_coercions(Num, 'int($_)')->freeze;
 
 should_pass("4", $RoundedInteger);
 should_fail("1.1", $RoundedInteger);
 should_fail("xyz", $RoundedInteger);
 
 my $String3 = declare String3 => as StrMatch[qr/^.{3}$/];
-$String3->coercion->add_type_coercions(Str, 'substr("$_   ", 0, 3)');
+$String3->coercion->add_type_coercions(Str, 'substr("$_   ", 0, 3)')->freeze;
 
 should_pass("xyz", $String3);
 should_fail("x", $String3);

t/20-unit/Type-Coercion/inlining.t

@@ -50,6 +50,8 @@ use Test::Fatal;
 
 	coerce JsonArray,
 		from Str, 'JSON::PP::decode_json($_)';
+
+	__PACKAGE__->meta->make_immutable;
 }
 
 my $code = T::JsonArray->coercion->inline_coercion('$::foo');

t/20-unit/Types-Standard/deep-coercions.t

@@ -139,8 +139,10 @@ NONINLINED: {
 INLINED: {
 	my $Bar = declare Bar => as Int;
 	coerce $Bar, from Num, q { int($_) };
+	$Bar->coercion->freeze;
 
 	my $ArrayOfBar = ArrayRef[$Bar];
+	$ArrayOfBar->coercion->freeze;
 
 	ok($ArrayOfBar->has_coercion, '$ArrayOfBar has coercion');
 	ok($ArrayOfBar->coercion->can_be_inlined, '$ArrayOfBar coercion can be inlined');
@@ -167,6 +169,7 @@ INLINED: {
 	);
 
 	my $HashOfBar = HashRef[$Bar];
+	$HashOfBar->coercion->freeze;
 
 	ok($HashOfBar->has_coercion, '$HashOfBar has coercion');
 	ok($HashOfBar->coercion->can_be_inlined, '$HashOfBar coercion can be inlined');
@@ -193,6 +196,8 @@ INLINED: {
 	);
 
 	my $RefOfBar = ScalarRef[$Bar];
+	$RefOfBar->coercion->freeze;
+
 	ok($RefOfBar->has_coercion, '$RefOfBar has coercion');
 	ok($RefOfBar->coercion->can_be_inlined, '$RefOfBar coercion can be inlined');
 
@@ -220,6 +225,7 @@ INLINED: {
 	# This added coercion should be ignored, because undef shouldn't
 	# need coercion!
 	my $MaybeBar = Maybe[$Bar->plus_coercions(Undef, 999)];
+	$MaybeBar->coercion->freeze;
 
 	is(
 		$MaybeBar->coerce(undef),
@@ -256,6 +262,8 @@ MAP: {
 	my $IntFromArray = declare IntFromArray => as Int;
 	coerce $IntFromArray, from ArrayRef, via { scalar(@$_) };
 
+	$_->coercion->freeze for $IntFromStr, $IntFromNum, $IntFromArray;
+
 	my $Map1 = Map[$IntFromNum, $IntFromStr];
 	ok(
 		$Map1->has_coercion && $Map1->coercion->can_be_inlined,
@@ -307,10 +315,12 @@ DICT: {
 
 	my $IntFromNum = declare IntFromNum => as Int;
 	coerce $IntFromNum, from Num, q{ int($_) };
-
+	
 	my $IntFromArray = declare IntFromArray => as Int;
 	coerce $IntFromArray, from ArrayRef, via { scalar(@$_) };
 
+	$_->coercion->freeze for $IntFromStr, $IntFromNum, $IntFromArray;
+
 	my @a = (a => $IntFromStr, b => $IntFromNum, c => Optional[$IntFromNum]);
 
 	my $Dict1 = Dict[ a => $IntFromStr, b => $IntFromNum, c => Optional[$IntFromNum] ];
@@ -365,6 +375,8 @@ TUPLE: {
 	my $IntFromArray = declare IntFromArray => as Int;
 	coerce $IntFromArray, from ArrayRef, via { scalar(@$_) };
 
+	$_->coercion->freeze for $IntFromStr, $IntFromNum, $IntFromArray;
+
 	my $Tuple1 = Tuple[ $IntFromNum, Optional[$IntFromStr], slurpy ArrayRef[$IntFromNum]];
 	ok(
 		$Tuple1->has_coercion && $Tuple1->coercion->can_be_inlined,

t/30-integration/Moo/coercion-inlining-avoidance.t

@@ -0,0 +1,155 @@
+=pod
+
+=encoding utf-8
+
+=head1 PURPOSE
+
+A rather complex case of defining an attribute with a type coercion in
+Moo; and only then adding coercion definitions to it. Does Moo pick up
+on the changes? It should.
+
+=head1 DEPENDENCIES
+
+Test is skipped if Moo 1.004000 is not available.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2014 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Requires { 'Moo' => '1.004000' };
+use Test::Fatal;
+
+use Types::Standard -types;
+
+my $e;
+
+my $type = Int->create_child_type(
+	name     => 'MyInt',
+	coercion => [ Num, q[int($_)] ],
+);
+
+ok(
+	!$type->coercion->frozen,
+	'created a type constraint without a frozen coercion',
+);
+
+ok(
+	!$type->coercion->can_be_inlined,
+	'... it reports that it cannot be inlined',
+);
+
+{
+	package Foo;
+	use Moo;
+	has foo => (is => 'ro', isa => $type, coerce => $type->coercion);
+}
+
+# We need to do some quick checks before adding the coercions,
+# partly because this is interesting to check, and partly because
+# we need to ensure that the 
+is(
+	Foo->new(foo => 3.2)->foo,
+	3,
+	'initial use of type in a Moo constructor',
+);
+
+$e = exception { Foo->new(foo => [3..4])->foo };
+like(
+	$e->message,
+	qr/did not pass type constraint/,
+	'... and it cannot coerce from an arrayref',
+);
+
+$e = exception { Foo->new(foo => { value => 42 })->foo };
+like(
+	$e->message,
+	qr/did not pass type constraint/,
+	'... and it cannot coerce from an hashref',
+);
+
+is(
+	exception {
+		$type->coercion->add_type_coercions(
+			ArrayRef,  q[scalar(@$_)],
+			HashRef,   q[$_->{value}],
+			ScalarRef, q["this is just a talisman"],
+		);
+	},
+	undef,
+	'can add coercions from ArrayRef and HashRef to the type',
+);
+
+ok(
+	!$type->coercion->frozen,
+	'... it is still not frozen',
+);
+
+ok(
+	!$type->coercion->can_be_inlined,
+	'... it reports that it still cannot be inlined',
+);
+
+is(
+	Foo->new(foo => 3.2)->foo,
+	3,
+	'again use of type in a Moo constructor',
+);
+
+is(
+	Foo->new(foo => [3..4])->foo,
+	2,
+	'... but can coerce from ArrayRef',
+);
+
+is(
+	Foo->new(foo => { value => 42 })->foo,
+	42,
+	'... and can coerce from HashRef',
+);
+
+is(
+	exception { $type->coercion->freeze },
+	undef,
+	'can freeze the coercion',
+);
+
+ok(
+	$type->coercion->frozen,
+	'... it reports that it is frozen',
+);
+
+ok(
+	$type->coercion->can_be_inlined,
+	'... it reports that it can be inlined',
+);
+
+{
+	package Goo;
+	use Moo;
+	has foo => (is => 'ro', isa => $type, coerce => $type->coercion);
+}
+
+Goo->new;
+
+if ( $ENV{AUTHOR_TESTING} )
+{
+	require B::Deparse;
+	my $deparsed = B::Deparse->new->coderef2text(\&Goo::new);
+	like($deparsed, qr/talisman/i, 'Moo inlining for coercions')
+		or diag($deparsed);
+}
+
+done_testing;