Revert "Hash accessor should accept more than 2 arguments"

[gitmo/Moose.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
index 69254f5..1bf35f2 100644 (file)
--- a/t/040_type_constraints/009_union_types_and_coercions.t
+++ b/t/040_type_constraints/009_union_types_and_coercions.t
@@ -4,15 +4,12 @@ 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;    
-}
-
+use Test::Fatal;
 
+use Test::Requires {
+    'IO::String' => '0.01', # skip all if not installed
+    'IO::File' => '0.01',
+};
 
 {
     package Email::Moose;
@@ -44,13 +41,13 @@ 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::StringOrFile',
@@ -70,93 +67,121 @@ 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'); 
-    
-    lives_ok {
-        $email->raw_body('... this is the next body ...');   
-    } '... this will coerce correctly';
-    
+
+    is($email->as_string, '... this is my body ...', '... got correct string');
+
+    is( exception {
+        $email->raw_body('... this is the next body ...');
+    }, undef, '... 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) ...';    
-    
-    lives_ok {
-        $email->raw_body(\$str2);   
-    } '... this will coerce correctly';
-    
+
+    is($email->as_string, $str, '... got correct string');
+
+    my $str2 = '... this is the next body (ref) ...';
+
+    is( exception {
+        $email->raw_body(\$str2);
+    }, undef, '... 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) ...');    
-    
-    lives_ok {
-        $email->raw_body($io_str2);   
-    } '... this will coerce correctly';
-    
+
+    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( exception {
+        $email->raw_body($io_str2);
+    }, undef, '... 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;
+    is( exception { $foo = Foo->new( carray => 1 ) }, undef, 'Can pass non-ref value for carray' );
+    is_deeply(
+        $foo->carray, [1],
+        'carray was coerced to an array ref'
+    );
 
+    like( exception { 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;