X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FUnion.pm;h=0ee81659dcc94141c869b168598c41db0f1aa33d;hb=c05704596921f27fba4b1148dfed3ddd0d15795e;hp=f1c026289a7933e113a3ac6bb851c2abe47ae426;hpb=576c9cfccb583b51f27bc6e0bfbc51eecb95dfc9;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/TypeConstraint/Union.pm b/lib/Moose/Meta/TypeConstraint/Union.pm
index f1c0262..0ee8165 100644
--- a/lib/Moose/Meta/TypeConstraint/Union.pm
+++ b/lib/Moose/Meta/TypeConstraint/Union.pm
@@ -14,7 +14,8 @@ use base 'Moose::Meta::TypeConstraint';
 
 __PACKAGE__->meta->add_attribute('type_constraints' => (
     accessor  => 'type_constraints',
-    default   => sub { [] }
+    default   => sub { [] },
+    Class::MOP::_definition_context(),
 ));
 
 sub new {
@@ -28,7 +29,7 @@ sub new {
         %options,
     );
 
-    $self->_set_constraint(sub { $self->check($_[0]) });
+    $self->_set_constraint( $self->_compiled_type_constraint );
 
     return $self;
 }
@@ -74,7 +75,13 @@ sub _actually_compile_type_constraint {
 sub can_be_inlined {
     my $self = shift;
 
-    return all { $_->can_be_inlined } @{ $self->type_constraints };
+    # This was originally done with all() from List::MoreUtils, but that
+    # caused some sort of bizarro parsing failure under 5.10.
+    for my $tc ( @{ $self->type_constraints } ) {
+        return 0 unless $tc->can_be_inlined;
+    }
+
+    return 1;
 }
 
 sub _inline_check {
@@ -87,7 +94,7 @@ sub _inline_check {
                   @{ $self->type_constraints }
                  )
            . ')';
-};
+}
 
 sub inline_environment {
     my $self = shift;
@@ -121,9 +128,16 @@ sub equals {
     return @other_constraints == 0;
 }
 
-sub parents {
+sub parent {
     my $self = shift;
-    $self->type_constraints;
+
+    my ($first, @rest) = @{ $self->type_constraints };
+
+    for my $parent ( $first->_collect_all_parents ) {
+        return $parent if all { $_->is_a_type_of($parent) } @rest;
+    }
+
+    return;
 }
 
 sub validate {
@@ -146,18 +160,14 @@ sub find_type_for {
 
 sub is_a_type_of {
     my ($self, $type_name) = @_;
-    foreach my $type (@{$self->type_constraints}) {
-        return 1 if $type->is_a_type_of($type_name);
-    }
-    return 0;
+
+    return all { $_->is_a_type_of($type_name) } @{ $self->type_constraints };
 }
 
 sub is_subtype_of {
     my ($self, $type_name) = @_;
-    foreach my $type (@{$self->type_constraints}) {
-        return 1 if $type->is_subtype_of($type_name);
-    }
-    return 0;
+
+    return all { $_->is_subtype_of($type_name) } @{ $self->type_constraints };
 }
 
 sub create_child_type {
@@ -226,9 +236,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) >>
 
@@ -254,12 +264,12 @@ a given value matches.
 
 =item B<< $constraint->is_a_type_of($type_name_or_object) >>
 
-This returns true if any of the member type constraints return true
+This returns true if all of the member type constraints return true
 for the C<is_a_type_of> method.
 
 =item B<< $constraint->is_subtype_of >>
 
-This returns true if any of the member type constraints return true
+This returns true if all of the member type constraints return true
 for the C<is_a_subtype_of> method.
 
 =item B<< $constraint->create_child_type(%options) >>