Fix Union->parent to return the nearest common ancestor

This lets us revert an earlier change to TC->is_subtype_of

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index e135a38..f5dd147 100644 (file)
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -289,7 +289,7 @@ sub is_subtype_of {
     my $current = $self;
 
     while (my $parent = $current->parent) {
-        return 1 if $parent->is_a_type_of($type);
+        return 1 if $parent->equals($type);
         $current = $parent;
     }
 
@@ -420,6 +420,11 @@ sub _collect_all_parents {
     return @parents;
 }
 
+sub _ancestor_count {
+    my $self = shift;
+    return scalar $self->_collect_all_parents;
+}
+
 sub create_child_type {
     my ($self, %opts) = @_;
     my $class = ref $self;

diff --git a/lib/Moose/Meta/TypeConstraint/Union.pm b/lib/Moose/Meta/TypeConstraint/Union.pm
index b604fe9..410c622 100644 (file)
--- a/lib/Moose/Meta/TypeConstraint/Union.pm
+++ b/lib/Moose/Meta/TypeConstraint/Union.pm
@@ -128,9 +128,17 @@ sub equals {
     return @other_constraints == 0;
 }
 
-sub parents {
+sub parent {
     my $self = shift;
-    $self->type_constraints;
+
+    my @tcs = @{ $self->type_constraints };
+
+    my $deepest
+        = ( sort { $a->_ancestor_count <=> $b->_ancestor_count } @tcs )[-1];
+
+    for my $parent ( $deepest->_collect_all_parents ) {
+        return $parent if all { $_->is_a_type_of($parent) } @tcs;
+    }
 }
 
 sub validate {
@@ -229,9 +237,9 @@ attribute is a L<Moose::Meta::TypeCoercion::Union> object.
 This returns the array reference of C<type_constraints> provided to
 the constructor.
 
-=item B<< $constraint->parents >>
+=item B<< $constraint->parent >>
 
-This returns the same constraint as the C<type_constraints> method.
+This returns the nearest common ancestor of all the components of the union.
 
 =item B<< $constraint->check($value) >>