Add two test file about union types

[gitmo/Mouse.git] / t / 040_type_constraints / 009_union_types_and_coercions.t

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