more tests for the mixed string and perl type constraints in union type constraints...

diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index 12c7f48..fdbaf9f 100644 (file)
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -24,10 +24,18 @@ use overload(
         ## is needed for syntax compatibility.  Maybe someday we'll all just do
         ## Or[Str,Str,Int]
 
-       my @tc = map {
-           blessed $_ ? $_ :
-             Moose::Util::TypeConstraints::find_or_parse_type_constraint($_)
-       } @_;
+        my @args = @_[0,1]; ## arg 3 is special,  see the overload docs.
+        my @tc = grep {blessed $_} map {
+            blessed $_ ? $_ :
+            Moose::Util::TypeConstraints::find_or_parse_type_constraint($_)
+              || croak "$_ is not a type constraint"
+        } @args;
+
+        ( scalar @tc == scalar @args)
+            || croak "one of your type constraints is bad.  Passed: ". join(', ', @args) ." Got: ". join(', ', @tc);
+
+        ( scalar @tc >= 2 )
+            || croak "You must pass in at least 2 type names to make a union";
 
         my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
         return Moose::Util::TypeConstraints::register_type_constraint($union);

diff --git a/t/20_union_with_string_type.t b/t/20_union_with_string_type.t
index 2d35deb..2b0bdfa 100644 (file)
--- a/t/20_union_with_string_type.t
+++ b/t/20_union_with_string_type.t
@@ -2,20 +2,49 @@
 use strict;
 use warnings;
 
-use Test::More tests => 1;
+use Test::More tests => 14;
 
 my $exception;
 {
     package TypeLib;
 
-    use MooseX::Types -declare => [qw( MyUnionType MyStr )];
-    use MooseX::Types::Moose qw(Str Item);
+    use MooseX::Types -declare => [qw( MyUnionType Test1 Test2 Test3 MyStr )];
+    use MooseX::Types::Moose qw(Str Int Item Object);
 
     subtype MyUnionType, as Str|'Int';
     subtype MyStr, as Str;
 
     eval { coerce MyStr, from Item, via {"$_"} };
-    $exception = $@;
-}
+    my $exception = $@;
+
+       Test::More::ok !$@, 'types are not mutated by union with a string type';
+
+       subtype Test1, 
+         as Int | 'ArrayRef[Int]';
+       
+       Test::More::ok Test1->check(1), '1 is an Int';
+       Test::More::ok !Test1->check('a'),  'a is not an Int';
+       Test::More::ok Test1->check([1, 2, 3]),  'Passes ArrayRef';
+       Test::More::ok !Test1->check([1, 'a', 3]),  'Fails ArrayRef with a letter';
+       Test::More::ok !Test1->check({a=>1}), 'fails wrong ref type';
+
+       eval {
+       subtype Test2, 
+        as Int | 'IDONTEXIST';
+       };
 
-ok !$@, 'types are not mutated by union with a string type';
+       my $check = $@;
+
+       Test::More::ok $@, 'Got an error for bad Type'; 
+       Test::More::like $check,  qr/IDONTEXIST is not a type constraint/,  'correct error';
+
+       my $obj = subtype Test3, 
+         as Int | 'ArrayRef[Int]' | Object;
+
+       Test::More::ok Test3->check(1), '1 is an Int';
+       Test::More::ok !Test3->check('a'),  'a is not an Int';
+       Test::More::ok Test3->check([1, 2, 3]),  'Passes ArrayRef';
+       Test::More::ok !Test3->check([1, 'a', 3]),  'Fails ArrayRef with a letter';
+       Test::More::ok !Test3->check({a=>1}), 'fails wrong ref type';
+       Test::More::ok Test3->check($obj), 'Union allows Object';
+}