t/040_type_constraints/009_union_types_and_coercions.t

   1 #!/usr/bin/perl
   2 # This is automatically generated by author/import-moose-test.pl.
   3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
   4 use t::lib::MooseCompat;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10 use Test::Exception;
  11
  12 use Test::Requires {
  13     'IO::String' => '0.01', # skip all if not installed
  14     'IO::File' => '0.01',
  15 };
  16
  17 {
  18     package Email::Mouse;
  19     use Mouse;
  20     use Mouse::Util::TypeConstraints;
  21
  22     use IO::String;
  23
  24     our $VERSION = '0.01';
  25
  26     # create subtype for IO::String
  27
  28     subtype 'IO::String'
  29         => as 'Object'
  30         => where { $_->isa('IO::String') };
  31
  32     coerce 'IO::String'
  33         => from 'Str'
  34             => via { IO::String->new($_) },
  35         => from 'ScalarRef',
  36             => via { IO::String->new($_) };
  37
  38     # create subtype for IO::File
  39
  40     subtype 'IO::File'
  41         => as 'Object'
  42         => where { $_->isa('IO::File') };
  43
  44     coerce 'IO::File'
  45         => from 'FileHandle'
  46             => via { bless $_, 'IO::File' };
  47
  48     # create the alias
  49
  50     subtype 'IO::StringOrFile' => as 'IO::String | IO::File';
  51
  52     # attributes
  53
  54     has 'raw_body' => (
  55         is      => 'rw',
  56         isa     => 'IO::StringOrFile',
  57         coerce  => 1,
  58         default => sub { IO::String->new() },
  59     );
  60
  61     sub as_string {
  62         my ($self) = @_;
  63         my $fh = $self->raw_body();
  64         return do { local $/; <$fh> };
  65     }
  66 }
  67
  68 {
  69     my $email = Email::Mouse->new;
  70     isa_ok($email, 'Email::Mouse');
  71
  72     isa_ok($email->raw_body, 'IO::String');
  73
  74     is($email->as_string, undef, '... got correct empty string');
  75 }
  76
  77 {
  78     my $email = Email::Mouse->new(raw_body => '... this is my body ...');
  79     isa_ok($email, 'Email::Mouse');
  80
  81     isa_ok($email->raw_body, 'IO::String');
  82
  83     is($email->as_string, '... this is my body ...', '... got correct string');
  84
  85     lives_ok {
  86         $email->raw_body('... this is the next body ...');
  87     } '... this will coerce correctly';
  88
  89     isa_ok($email->raw_body, 'IO::String');
  90
  91     is($email->as_string, '... this is the next body ...', '... got correct string');
  92 }
  93
  94 {
  95     my $str = '... this is my body (ref) ...';
  96
  97     my $email = Email::Mouse->new(raw_body => \$str);
  98     isa_ok($email, 'Email::Mouse');
  99
 100     isa_ok($email->raw_body, 'IO::String');
 101
 102     is($email->as_string, $str, '... got correct string');
 103
 104     my $str2 = '... this is the next body (ref) ...';
 105
 106     lives_ok {
 107         $email->raw_body(\$str2);
 108     } '... this will coerce correctly';
 109
 110     isa_ok($email->raw_body, 'IO::String');
 111
 112     is($email->as_string, $str2, '... got correct string');
 113 }
 114
 115 {
 116     my $io_str = IO::String->new('... this is my body (IO::String) ...');
 117
 118     my $email = Email::Mouse->new(raw_body => $io_str);
 119     isa_ok($email, 'Email::Mouse');
 120
 121     isa_ok($email->raw_body, 'IO::String');
 122     is($email->raw_body, $io_str, '... and it is the one we expected');
 123
 124     is($email->as_string, '... this is my body (IO::String) ...', '... got correct string');
 125
 126     my $io_str2 = IO::String->new('... this is the next body (IO::String) ...');
 127
 128     lives_ok {
 129         $email->raw_body($io_str2);
 130     } '... this will coerce correctly';
 131
 132     isa_ok($email->raw_body, 'IO::String');
 133     is($email->raw_body, $io_str2, '... and it is the one we expected');
 134
 135     is($email->as_string, '... this is the next body (IO::String) ...', '... got correct string');
 136 }
 137
 138 {
 139     my $fh;
 140
 141     open($fh, '<', $0) || die "Could not open $0";
 142
 143     my $email = Email::Mouse->new(raw_body => $fh);
 144     isa_ok($email, 'Email::Mouse');
 145
 146     isa_ok($email->raw_body, 'IO::File');
 147
 148     close($fh);
 149 }
 150
 151 {
 152     my $fh = IO::File->new($0);
 153
 154     my $email = Email::Mouse->new(raw_body => $fh);
 155     isa_ok($email, 'Email::Mouse');
 156
 157     isa_ok($email->raw_body, 'IO::File');
 158     is($email->raw_body, $fh, '... and it is the one we expected');
 159 }
 160
 161 {
 162     package Foo;
 163
 164     use Mouse;
 165     use Mouse::Util::TypeConstraints;
 166
 167     subtype 'Coerced' => as 'ArrayRef';
 168     coerce 'Coerced'
 169         => from 'Value'
 170         => via { [ $_ ] };
 171
 172     has carray => (
 173         is     => 'ro',
 174         isa    => 'Coerced | Coerced',
 175         coerce => 1,
 176     );
 177 }
 178
 179 {
 180     my $foo;
 181     lives_ok { $foo = Foo->new( carray => 1 ) }
 182     'Can pass non-ref value for carray';
 183     is_deeply(
 184         $foo->carray, [1],
 185         'carray was coerced to an array ref'
 186     );
 187
 188     throws_ok { Foo->new( carray => {} ) }
 189     qr/\QValidation failed for 'Coerced|Coerced' with value \E(?!undef)/,
 190         'Cannot pass a hash ref for carray attribute, and hash ref is not coerced to an undef';
 191 }
 192
 193 done_testing;