From: Dave Rolsky <autarch@urth.org>
Date: Sun, 4 Jul 2010 16:36:52 +0000 (-0500)
Subject: Fix two bugs coercions for union types
X-Git-Tag: 1.11~13
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4beacd39f48c283cd92d9c6231b97e5413076e14;p=gitmo%2FMoose.git

Fix two bugs coercions for union types

First, the union type always made a coercion, even if none its constituent types had a coercion.

Second, the union coercion always returned undef if none of the coercions
actually coerced. This caused union types which included undef to always pass
the constraint. In other case, returning undef simply led to a bad error
message saying undef did not pass the type constraint.
---

diff --git a/Changes b/Changes
index e1a734a..b91f9b0 100644
--- a/Changes
+++ b/Changes
@@ -65,6 +65,17 @@ for, noteworthy changes.
   * Accessors will no longer be inlined if the instance metaclass isn't
     inlinable. (doy)
 
+  * Union types always created a type constraint, even if their constituent
+    constraints did not have any coercions. This bogus coercion always
+    returned undef, which meant that a union which included Undef as a member
+    always coerced bad values to undef. Reported by Eric Brine. RT
+    #58411. (Dave Rolsky)
+
+  * Union types with coercions would always fall back to coercing the value to
+    undef (unintentionally). Now if all the coercions for a union type fail,
+    the value returned by the coercion is the original value that we attempted
+    to coerce. (Dave Rolsky).
+
   * Use Perl 5.10's new recursive regex features, if possible, for the type
     constraint parser. (doy, nothingmuch)
 
diff --git a/lib/Moose/Meta/TypeCoercion/Union.pm b/lib/Moose/Meta/TypeCoercion/Union.pm
index e2c4e1d..e76585d 100644
--- a/lib/Moose/Meta/TypeCoercion/Union.pm
+++ b/lib/Moose/Meta/TypeCoercion/Union.pm
@@ -36,7 +36,7 @@ sub compile_type_coercion {
                 return $temp if $type_constraint->check($temp);
             }
         }
-        return undef;
+        return $value;
     });
 }
 
diff --git a/lib/Moose/Meta/TypeConstraint/Union.pm b/lib/Moose/Meta/TypeConstraint/Union.pm
index 135fe79..41654f6 100644
--- a/lib/Moose/Meta/TypeConstraint/Union.pm
+++ b/lib/Moose/Meta/TypeConstraint/Union.pm
@@ -32,9 +32,13 @@ sub new {
     );
 
     $self->_set_constraint(sub { $self->check($_[0]) });
-    $self->coercion(Moose::Meta::TypeCoercion::Union->new(
-        type_constraint => $self
-    ));
+
+    if ( grep { $_->has_coercion } @{ $self->type_constraints } ) {
+        $self->coercion(
+            Moose::Meta::TypeCoercion::Union->new( type_constraint => $self )
+        );
+    }
+
     return $self;
 }
 
diff --git a/t/040_type_constraints/009_union_types_and_coercions.t b/t/040_type_constraints/009_union_types_and_coercions.t
index abedd6c..4066ff8 100644
--- a/t/040_type_constraints/009_union_types_and_coercions.t
+++ b/t/040_type_constraints/009_union_types_and_coercions.t
@@ -155,4 +155,56 @@ use Test::Requires {
     is($email->raw_body, $fh, '... and it is the one we expected');
 }
 
+{
+    package Foo;
+
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    has nothing => (
+        is  => 'ro',
+        isa => 'Undef | Undef',
+    );
+
+    has nothing2 => (
+        is     => 'ro',
+        isa    => 'Undef | Undef',
+        coerce => 1,
+    );
+
+    subtype 'Coerced' => as 'ArrayRef';
+    coerce 'Coerced'
+        => from 'Value'
+        => via { [ $_ ] };
+
+    has carray => (
+        is     => 'ro',
+        isa    => 'Coerced | Coerced',
+        coerce => 1,
+    );
+}
+
+{
+    throws_ok { Foo->new( nothing => 1 ) }
+    qr/\QValidation failed for 'Undef|Undef' with value 1/,
+        'Cannot pass defined value for nothing attribute';
+
+    throws_ok { Foo->new( nothing2 => 1 ) }
+    qr/\QValidation failed for 'Undef|Undef' with value 1/,
+        'Cannot pass defined value for nothing2 attribute';
+
+    {
+        my $foo;
+        lives_ok { $foo = Foo->new( carray => 1 ) }
+            'Can pass non-ref value for carray';
+        is_deeply(
+            $foo->carray, [1],
+            'carray was coerced to an array ref'
+        );
+    }
+
+    throws_ok { Foo->new( carray => {} ) } qr/\QValidation failed for 'Coerced|Coerced' with value \E(?!undef)/,
+        'Cannot pass a hash ref for carray attribute, and hash ref is not coerced to an undef';
+}
+
 done_testing;