Add two test file about union types

diff --git a/t/040_type_constraints/009_union_types_and_coercions.t b/t/040_type_constraints/009_union_types_and_coercions.t
new file mode 100755 (executable)
index 0000000..588c1a7
--- /dev/null
+++ b/t/040_type_constraints/009_union_types_and_coercions.t
@@ -0,0 +1,163 @@
+#!/usr/bin/perl\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use Test::More;\r
+use Test::Exception;\r
+\r
+BEGIN {\r
+    eval "use IO::String; use IO::File;";\r
+    plan skip_all => "IO::String and IO::File are required for this test" if $@;\r
+    plan tests => 28;\r
+}\r
+\r
+\r
+\r
+{\r
+    package Email::Mouse;\r
+    use Mouse;\r
+    use Mouse::Util::TypeConstraints;\r
+\r
+    use IO::String;\r
+\r
+    our $VERSION = '0.01';\r
+\r
+    # create subtype for IO::String\r
+\r
+    subtype 'IO::String'\r
+        => as 'Object'\r
+        => where { $_->isa('IO::String') };\r
+\r
+    coerce 'IO::String'\r
+        => from 'Str'\r
+            => via { IO::String->new($_) },\r
+        => from 'ScalarRef',\r
+            => via { IO::String->new($_) };\r
+\r
+    # create subtype for IO::File\r
+\r
+    subtype 'IO::File'\r
+        => as 'Object'\r
+        => where { $_->isa('IO::File') };\r
+\r
+    coerce 'IO::File'\r
+        => from 'FileHandle'\r
+            => via { bless $_, 'IO::File' };\r
+\r
+    # create the alias\r
+\r
+    my $st = subtype 'IO::StringOrFile' => as 'IO::String | IO::File';\r
+\r
+    # attributes\r
+\r
+    has 'raw_body' => (\r
+        is      => 'rw',\r
+        isa     => 'IO::StringOrFile',\r
+        coerce  => 1,\r
+        default => sub { IO::String->new() },\r
+    );\r
+\r
+    sub as_string {\r
+        my ($self) = @_;\r
+        my $fh = $self->raw_body();\r
+\r
+        return do { local $/; <$fh> };\r
+    }\r
+}\r
+\r
+{\r
+    my $email = Email::Mouse->new;\r
+    isa_ok($email, 'Email::Mouse');\r
+\r
+    isa_ok($email->raw_body, 'IO::String');\r
+\r
+    is($email->as_string, undef, '... got correct empty string');\r
+}\r
+\r
+{\r
+    my $email = Email::Mouse->new(raw_body => '... this is my body ...');\r
+    isa_ok($email, 'Email::Mouse');\r
+\r
+    isa_ok($email->raw_body, 'IO::String');\r
+\r
+    is($email->as_string, '... this is my body ...', '... got correct string');\r
+\r
+    lives_ok {\r
+        $email->raw_body('... this is the next body ...');\r
+    } '... this will coerce correctly';\r
+\r
+    isa_ok($email->raw_body, 'IO::String');\r
+\r
+    is($email->as_string, '... this is the next body ...', '... got correct string');\r
+}\r
+\r
+{\r
+    my $str = '... this is my body (ref) ...';\r
+\r
+    my $email = Email::Mouse->new(raw_body => \$str);\r
+    isa_ok($email, 'Email::Mouse');\r
+\r
+    isa_ok($email->raw_body, 'IO::String');\r
+\r
+    is($email->as_string, $str, '... got correct string');\r
+\r
+    my $str2 = '... this is the next body (ref) ...';\r
+\r
+    lives_ok {\r
+        $email->raw_body(\$str2);\r
+    } '... this will coerce correctly';\r
+\r
+    isa_ok($email->raw_body, 'IO::String');\r
+\r
+    is($email->as_string, $str2, '... got correct string');\r
+}\r
+\r
+{\r
+    my $io_str = IO::String->new('... this is my body (IO::String) ...');\r
+\r
+    my $email = Email::Mouse->new(raw_body => $io_str);\r
+    isa_ok($email, 'Email::Mouse');\r
+\r
+    isa_ok($email->raw_body, 'IO::String');\r
+    is($email->raw_body, $io_str, '... and it is the one we expected');\r
+\r
+    is($email->as_string, '... this is my body (IO::String) ...', '... got correct string');\r
+\r
+    my $io_str2 = IO::String->new('... this is the next body (IO::String) ...');\r
+\r
+    lives_ok {\r
+        $email->raw_body($io_str2);\r
+    } '... this will coerce correctly';\r
+\r
+    isa_ok($email->raw_body, 'IO::String');\r
+    is($email->raw_body, $io_str2, '... and it is the one we expected');\r
+\r
+    is($email->as_string, '... this is the next body (IO::String) ...', '... got correct string');\r
+}\r
+\r
+{\r
+    my $fh;\r
+\r
+    open($fh, '<', $0) || die "Could not open $0";\r
+\r
+    my $email = Email::Mouse->new(raw_body => $fh);\r
+    isa_ok($email, 'Email::Mouse');\r
+\r
+    isa_ok($email->raw_body, 'IO::File');\r
+\r
+    close($fh);\r
+}\r
+\r
+{\r
+    my $fh = IO::File->new($0);\r
+\r
+    my $email = Email::Mouse->new(raw_body => $fh);\r
+    isa_ok($email, 'Email::Mouse');\r
+\r
+    isa_ok($email->raw_body, 'IO::File');\r
+    is($email->raw_body, $fh, '... and it is the one we expected');\r
+}\r
+\r
+\r
+\r

diff --git a/t/040_type_constraints/017_subtyping_union_types.t b/t/040_type_constraints/017_subtyping_union_types.t
new file mode 100755 (executable)
index 0000000..ff8d90d
--- /dev/null
+++ b/t/040_type_constraints/017_subtyping_union_types.t
@@ -0,0 +1,69 @@
+#!/usr/bin/perl\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use Test::More tests => 21;\r
+use Test::Exception;\r
+\r
+BEGIN {\r
+    use_ok("Moose::Util::TypeConstraints");\r
+}\r
+\r
+lives_ok {\r
+    subtype 'MyCollections' => as 'ArrayRef | HashRef';\r
+} '... created the subtype special okay';\r
+\r
+{\r
+    my $t = find_type_constraint('MyCollections');\r
+    isa_ok($t, 'Moose::Meta::TypeConstraint');\r
+\r
+    is($t->name, 'MyCollections', '... name is correct');\r
+\r
+    my $p = $t->parent;\r
+    isa_ok($p, 'Moose::Meta::TypeConstraint::Union');\r
+    isa_ok($p, 'Moose::Meta::TypeConstraint');\r
+\r
+    is($p->name, 'ArrayRef|HashRef', '... parent name is correct');\r
+\r
+    ok($t->check([]), '... validated it correctly');\r
+    ok($t->check({}), '... validated it correctly');\r
+    ok(!$t->check(1), '... validated it correctly');\r
+}\r
+\r
+lives_ok {\r
+    subtype 'MyCollectionsExtended'\r
+        => as 'ArrayRef|HashRef'\r
+        => where {\r
+            if (ref($_) eq 'ARRAY') {\r
+                return if scalar(@$_) < 2;\r
+            }\r
+            elsif (ref($_) eq 'HASH') {\r
+                return if scalar(keys(%$_)) < 2;\r
+            }\r
+            1;\r
+        };\r
+} '... created the subtype special okay';\r
+\r
+{\r
+    my $t = find_type_constraint('MyCollectionsExtended');\r
+    isa_ok($t, 'Moose::Meta::TypeConstraint');\r
+\r
+    is($t->name, 'MyCollectionsExtended', '... name is correct');\r
+\r
+    my $p = $t->parent;\r
+    isa_ok($p, 'Moose::Meta::TypeConstraint::Union');\r
+    isa_ok($p, 'Moose::Meta::TypeConstraint');\r
+\r
+    is($p->name, 'ArrayRef|HashRef', '... parent name is correct');\r
+\r
+    ok(!$t->check([]), '... validated it correctly');\r
+    ok($t->check([1, 2]), '... validated it correctly');\r
+\r
+    ok(!$t->check({}), '... validated it correctly');\r
+    ok($t->check({ one => 1, two => 2 }), '... validated it correctly');\r
+\r
+    ok(!$t->check(1), '... validated it correctly');\r
+}\r
+\r
+\r