From: gfx <gfuji@cpan.org>
Date: Tue, 29 Sep 2009 08:04:35 +0000 (+0900)
Subject: Add two test file about union types
X-Git-Tag: 0.37_01~31
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=a254bf514576f3d4a5bcde5a0db4d4ced9ad566b

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
index 0000000..588c1a7
--- /dev/null
+++ b/t/040_type_constraints/009_union_types_and_coercions.t
@@ -0,0 +1,163 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+BEGIN {
+    eval "use IO::String; use IO::File;";
+    plan skip_all => "IO::String and IO::File are required for this test" if $@;
+    plan tests => 28;
+}
+
+
+
+{
+    package Email::Mouse;
+    use Mouse;
+    use Mouse::Util::TypeConstraints;
+
+    use IO::String;
+
+    our $VERSION = '0.01';
+
+    # create subtype for IO::String
+
+    subtype 'IO::String'
+        => as 'Object'
+        => where { $_->isa('IO::String') };
+
+    coerce 'IO::String'
+        => from 'Str'
+            => via { IO::String->new($_) },
+        => from 'ScalarRef',
+            => via { IO::String->new($_) };
+
+    # create subtype for IO::File
+
+    subtype 'IO::File'
+        => as 'Object'
+        => where { $_->isa('IO::File') };
+
+    coerce 'IO::File'
+        => from 'FileHandle'
+            => via { bless $_, 'IO::File' };
+
+    # create the alias
+
+    my $st = subtype 'IO::StringOrFile' => as 'IO::String | IO::File';
+
+    # attributes
+
+    has 'raw_body' => (
+        is      => 'rw',
+        isa     => 'IO::StringOrFile',
+        coerce  => 1,
+        default => sub { IO::String->new() },
+    );
+
+    sub as_string {
+        my ($self) = @_;
+        my $fh = $self->raw_body();
+
+        return do { local $/; <$fh> };
+    }
+}
+
+{
+    my $email = Email::Mouse->new;
+    isa_ok($email, 'Email::Mouse');
+
+    isa_ok($email->raw_body, 'IO::String');
+
+    is($email->as_string, undef, '... got correct empty string');
+}
+
+{
+    my $email = Email::Mouse->new(raw_body => '... this is my body ...');
+    isa_ok($email, 'Email::Mouse');
+
+    isa_ok($email->raw_body, 'IO::String');
+
+    is($email->as_string, '... this is my body ...', '... got correct string');
+
+    lives_ok {
+        $email->raw_body('... this is the next body ...');
+    } '... this will coerce correctly';
+
+    isa_ok($email->raw_body, 'IO::String');
+
+    is($email->as_string, '... this is the next body ...', '... got correct string');
+}
+
+{
+    my $str = '... this is my body (ref) ...';
+
+    my $email = Email::Mouse->new(raw_body => \$str);
+    isa_ok($email, 'Email::Mouse');
+
+    isa_ok($email->raw_body, 'IO::String');
+
+    is($email->as_string, $str, '... got correct string');
+
+    my $str2 = '... this is the next body (ref) ...';
+
+    lives_ok {
+        $email->raw_body(\$str2);
+    } '... this will coerce correctly';
+
+    isa_ok($email->raw_body, 'IO::String');
+
+    is($email->as_string, $str2, '... got correct string');
+}
+
+{
+    my $io_str = IO::String->new('... this is my body (IO::String) ...');
+
+    my $email = Email::Mouse->new(raw_body => $io_str);
+    isa_ok($email, 'Email::Mouse');
+
+    isa_ok($email->raw_body, 'IO::String');
+    is($email->raw_body, $io_str, '... and it is the one we expected');
+
+    is($email->as_string, '... this is my body (IO::String) ...', '... got correct string');
+
+    my $io_str2 = IO::String->new('... this is the next body (IO::String) ...');
+
+    lives_ok {
+        $email->raw_body($io_str2);
+    } '... this will coerce correctly';
+
+    isa_ok($email->raw_body, 'IO::String');
+    is($email->raw_body, $io_str2, '... and it is the one we expected');
+
+    is($email->as_string, '... this is the next body (IO::String) ...', '... got correct string');
+}
+
+{
+    my $fh;
+
+    open($fh, '<', $0) || die "Could not open $0";
+
+    my $email = Email::Mouse->new(raw_body => $fh);
+    isa_ok($email, 'Email::Mouse');
+
+    isa_ok($email->raw_body, 'IO::File');
+
+    close($fh);
+}
+
+{
+    my $fh = IO::File->new($0);
+
+    my $email = Email::Mouse->new(raw_body => $fh);
+    isa_ok($email, 'Email::Mouse');
+
+    isa_ok($email->raw_body, 'IO::File');
+    is($email->raw_body, $fh, '... and it is the one we expected');
+}
+
+
+
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
index 0000000..ff8d90d
--- /dev/null
+++ b/t/040_type_constraints/017_subtyping_union_types.t
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 21;
+use Test::Exception;
+
+BEGIN {
+    use_ok("Moose::Util::TypeConstraints");
+}
+
+lives_ok {
+    subtype 'MyCollections' => as 'ArrayRef | HashRef';
+} '... created the subtype special okay';
+
+{
+    my $t = find_type_constraint('MyCollections');
+    isa_ok($t, 'Moose::Meta::TypeConstraint');
+
+    is($t->name, 'MyCollections', '... name is correct');
+
+    my $p = $t->parent;
+    isa_ok($p, 'Moose::Meta::TypeConstraint::Union');
+    isa_ok($p, 'Moose::Meta::TypeConstraint');
+
+    is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
+
+    ok($t->check([]), '... validated it correctly');
+    ok($t->check({}), '... validated it correctly');
+    ok(!$t->check(1), '... validated it correctly');
+}
+
+lives_ok {
+    subtype 'MyCollectionsExtended'
+        => as 'ArrayRef|HashRef'
+        => where {
+            if (ref($_) eq 'ARRAY') {
+                return if scalar(@$_) < 2;
+            }
+            elsif (ref($_) eq 'HASH') {
+                return if scalar(keys(%$_)) < 2;
+            }
+            1;
+        };
+} '... created the subtype special okay';
+
+{
+    my $t = find_type_constraint('MyCollectionsExtended');
+    isa_ok($t, 'Moose::Meta::TypeConstraint');
+
+    is($t->name, 'MyCollectionsExtended', '... name is correct');
+
+    my $p = $t->parent;
+    isa_ok($p, 'Moose::Meta::TypeConstraint::Union');
+    isa_ok($p, 'Moose::Meta::TypeConstraint');
+
+    is($p->name, 'ArrayRef|HashRef', '... parent name is correct');
+
+    ok(!$t->check([]), '... validated it correctly');
+    ok($t->check([1, 2]), '... validated it correctly');
+
+    ok(!$t->check({}), '... validated it correctly');
+    ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
+
+    ok(!$t->check(1), '... validated it correctly');
+}
+
+