Support | overload to work better with MooseX::Types

lib/Moose/Meta/TypeConstraint.pm

@@ -6,6 +6,29 @@ use warnings;
 use metaclass;
 
 use overload '0+'     => sub { refaddr(shift) }, # id an object
+             '|'      => sub {
+
+                 ## It's kind of ugly that we need to know about Union Types, but this
+                 ## is needed for syntax compatibility.  Maybe someday we'll all just do
+                 ## Or[Str,Str,Int]
+
+                 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($_)
+                       || __PACKAGE__->_throw_error( "$_ is not a type constraint")
+                 } @args;
+
+                 ( scalar @tc == scalar @args)
+                     || __PACKAGE__->_throw_error(
+                       "one of your type constraints is bad.  Passed: ". join(', ', @args) ." Got: ". join(', ', @tc));
+
+                 ( scalar @tc >= 2 )
+                     || __PACKAGE__->_throw_error("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);
+             },
              '""'     => sub { shift->name },   # stringify to tc name
              bool     => sub { 1 },
              fallback => 1;

t/type_constraints/union_overload_or.t

@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+
+use Test::Fatal;
+use Test::More;
+
+{
+
+    package Duck;
+    use Moose;
+
+    sub quack { }
+
+}
+
+{
+
+    package Swan;
+    use Moose;
+
+    sub honk { }
+
+}
+
+{
+
+    package RubberDuck;
+    use Moose;
+
+    sub quack { }
+
+}
+
+
+use Moose::Util::TypeConstraints 'class_type';
+
+my $union = class_type('Duck') | class_type('RubberDuck');
+
+my $duck = Duck->new();
+my $rubber_duck = RubberDuck->new();
+my $swan = Swan->new();
+
+my @domain_values = ( $duck, $rubber_duck );
+is(
+    exception { $union->assert_valid($_) },
+    undef,
+    qq{Union accepts "$_".}
+) for @domain_values;
+
+like(
+    exception { $union->assert_valid($swan) },
+    qr/Validation failed for/,
+    qq{Union does not accept Swan.}
+);
+done_testing;
+