t/040_type_constraints/failing/009_union_types_and_coercions.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     eval "use IO::String; use IO::File;";
  11     plan skip_all => "IO::String and IO::File are required for this test" if $@;
  12     plan tests => 28;
  13 }
  14
  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