From: Dave Rolsky <autarch@urth.org>
Date: Fri, 16 Sep 2011 13:37:15 +0000 (-0500)
Subject: Union types look at all member types when determining if they're a subtype of something
X-Git-Tag: 2.0300~54
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoose.git;a=commitdiff_plain;h=a93d14d12227126813af4aa7f1caffd065820d6a

Union types look at all member types when determining if they're a subtype of something

In other words, "Int|ClassName" is not a subtype of Num, but it is a subtype of Item.
---

diff --git a/lib/Moose/Meta/TypeConstraint/Union.pm b/lib/Moose/Meta/TypeConstraint/Union.pm
index 0492e6e..b604fe9 100644
--- a/lib/Moose/Meta/TypeConstraint/Union.pm
+++ b/lib/Moose/Meta/TypeConstraint/Union.pm
@@ -153,18 +153,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 {
@@ -261,12 +257,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) >>
diff --git a/t/type_constraints/union_is_a_type_of.t b/t/type_constraints/union_is_a_type_of.t
new file mode 100644
index 0000000..3feef87
--- /dev/null
+++ b/t/type_constraints/union_is_a_type_of.t
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::Fatal;
+use Test::More;
+
+use Moose::Util::TypeConstraints 'find_type_constraint';
+
+use Moose::Meta::TypeConstraint::Union;
+
+my ( $item, $int, $classname, $num )
+    = map { find_type_constraint($_) } qw{Item Int ClassName Num};
+
+ok( $int->is_subtype_of($item),       'Int is subtype of Item' );
+ok( $classname->is_subtype_of($item), 'ClassName is subtype of Item' );
+ok(
+    ( not $int->is_subtype_of($classname) ),
+    'Int is not subtype of ClassName'
+);
+ok(
+    ( not $classname->is_subtype_of($int) ),
+    'ClassName is not subtype of Int'
+);
+
+my $union = Moose::Meta::TypeConstraint::Union->new(
+    type_constraints => [ $int, $classname ] );
+
+my @domain_values = qw( 85439 Moose::Meta::TypeConstraint );
+is(
+    exception { $union->assert_valid($_) },
+    undef,
+    qq{Union accepts "$_".}
+) for @domain_values;
+
+ok(
+    $union->is_subtype_of( find_type_constraint($_) ),
+    "Int|ClassName is a subtype of $_"
+) for qw{Item Defined Value Str};
+
+ok(
+    ( not $union->is_subtype_of( find_type_constraint($_) ) ),
+    "Int|ClassName is not a subtype of $_"
+) for qw{Num Int ClassName};
+
+ok(
+    ( not $union->is_a_type_of( find_type_constraint($_) ) ),
+    "Int|ClassName is not a type of $_"
+) for qw{Int ClassName};
+done_testing;