X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F040_type_constraints%2F009_union_types_and_coercions.t;h=e7071f2582a00cb7497fa0b9b21dd5123305f11b;hb=34d6d196372ac514abfe975cef15e8afd0af04c4;hp=c9a42b85e10089966de06ba0edef8a1b8777e9f3;hpb=e59a5c292a333cac504b65ebd4bba20b5e98d796;p=gitmo%2FMoose.git

diff --git a/t/040_type_constraints/009_union_types_and_coercions.t b/t/040_type_constraints/009_union_types_and_coercions.t
index c9a42b8..e7071f2 100644
--- a/t/040_type_constraints/009_union_types_and_coercions.t
+++ b/t/040_type_constraints/009_union_types_and_coercions.t
@@ -6,15 +6,10 @@ 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 => 29;    
-}
-
-BEGIN {
-    use_ok('Moose');           
-}
+use Test::Requires {
+    'IO::String' => '0.01', # skip all if not installed
+    'IO::File' => '0.01',
+};
 
 {
     package Email::Moose;
@@ -46,12 +41,16 @@ BEGIN {
     coerce 'IO::File'
         => from 'FileHandle'
             => via { bless $_, 'IO::File' };
-    
+
+    # create the alias
+
+    subtype 'IO::StringOrFile' => as 'IO::String | IO::File';
+
     # attributes
-    
+
     has 'raw_body' => (
         is      => 'rw',
-        isa     => 'IO::String | IO::File',
+        isa     => 'IO::StringOrFile',
         coerce  => 1,
         default => sub { IO::String->new() },
     );
@@ -68,93 +67,124 @@ BEGIN {
     isa_ok($email, 'Email::Moose');
 
     isa_ok($email->raw_body, 'IO::String');
-    
+
     is($email->as_string, undef, '... got correct empty string');
 }
 
 {
     my $email = Email::Moose->new(raw_body => '... this is my body ...');
     isa_ok($email, 'Email::Moose');
-    
+
     isa_ok($email->raw_body, 'IO::String');
-    
-    is($email->as_string, '... this is my body ...', '... got correct string'); 
-    
+
+    is($email->as_string, '... this is my body ...', '... got correct string');
+
     lives_ok {
-        $email->raw_body('... this is the next body ...');   
+        $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');    
+
+    is($email->as_string, '... this is the next body ...', '... got correct string');
 }
 
 {
     my $str = '... this is my body (ref) ...';
-    
+
     my $email = Email::Moose->new(raw_body => \$str);
     isa_ok($email, 'Email::Moose');
-    
+
     isa_ok($email->raw_body, 'IO::String');
-    
-    is($email->as_string, $str, '... got correct string');    
-    
-    my $str2 = '... this is the next body (ref) ...';    
-    
+
+    is($email->as_string, $str, '... got correct string');
+
+    my $str2 = '... this is the next body (ref) ...';
+
     lives_ok {
-        $email->raw_body(\$str2);   
+        $email->raw_body(\$str2);
     } '... this will coerce correctly';
-    
+
     isa_ok($email->raw_body, 'IO::String');
-    
-    is($email->as_string, $str2, '... got correct string');    
+
+    is($email->as_string, $str2, '... got correct string');
 }
 
 {
     my $io_str = IO::String->new('... this is my body (IO::String) ...');
-    
+
     my $email = Email::Moose->new(raw_body => $io_str);
     isa_ok($email, 'Email::Moose');
-    
+
     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) ...');    
-    
+
+    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);   
+        $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');       
+
+    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::Moose->new(raw_body => $fh);
     isa_ok($email, 'Email::Moose');
-    
+
     isa_ok($email->raw_body, 'IO::File');
-    
+
     close($fh);
 }
 
 {
     my $fh = IO::File->new($0);
-    
+
     my $email = Email::Moose->new(raw_body => $fh);
     isa_ok($email, 'Email::Moose');
-    
+
     isa_ok($email->raw_body, 'IO::File');
     is($email->raw_body, $fh, '... and it is the one we expected');
 }
 
+{
+    package Foo;
+
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    subtype 'Coerced' => as 'ArrayRef';
+    coerce 'Coerced'
+        => from 'Value'
+        => via { [ $_ ] };
+
+    has carray => (
+        is     => 'ro',
+        isa    => 'Coerced | Coerced',
+        coerce => 1,
+    );
+}
+
+{
+    my $foo;
+    lives_ok { $foo = Foo->new( carray => 1 ) }
+    'Can pass non-ref value for carray';
+    is_deeply(
+        $foo->carray, [1],
+        'carray was coerced to an array ref'
+    );
 
+    throws_ok { Foo->new( carray => {} ) }
+    qr/\QValidation failed for 'Coerced|Coerced' with value \E(?!undef)/,
+        'Cannot pass a hash ref for carray attribute, and hash ref is not coerced to an undef';
+}
 
+done_testing;