t/800_shikabased/802-mousex_types-isa-or.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 13;
   4
   5 {
   6     package Types;
   7     use strict;
   8     use warnings;
   9     use MouseX::Types -declare => [qw/ Baz Type1 Type2 /];
  10     use MouseX::Types::Mouse qw( ArrayRef );
  11
  12     type Baz, where { defined($_) && $_ eq 'Baz' };
  13     coerce Baz, from ArrayRef, via { 'Baz' };
  14
  15     type Type1, where { defined($_) && $_ eq 'Name' };
  16     coerce Type1, from 'Str', via { 'Names' };
  17
  18     type Type2, where { defined($_) && $_ eq 'Group' };
  19     coerce Type2, from 'Str', via { 'Name' };
  20
  21 }
  22
  23 {
  24     package Foo;
  25     use Mouse;
  26     use MouseX::Types::Mouse qw( Str Undef );
  27     BEGIN { Types->import(qw( Baz Type1 )) }
  28     has 'bar' => ( is => 'rw', isa => Str | Baz | Undef, coerce => 1 );
  29 }
  30
  31 eval {
  32     Foo->new( bar => +{} );
  33 };
  34 ok $@, 'not got an object';
  35
  36 eval {
  37     isa_ok(Foo->new( bar => undef ), 'Foo');
  38 };
  39 ok !$@, 'got an object 1';
  40
  41 eval {
  42     isa_ok(Foo->new( bar => 'foo' ), 'Foo');
  43
  44 };
  45 ok !$@, 'got an object 2';
  46
  47
  48 my $f = Foo->new;
  49 eval {
  50     $f->bar([]);
  51 };
  52 ok !$@;
  53 is $f->bar, 'Baz', 'bar is baz (coerce from ArrayRef)';
  54
  55 eval {
  56     $f->bar('hoge');
  57 };
  58 ok !$@;
  59 is $f->bar, 'hoge', 'bar is hoge';
  60
  61 eval {
  62     $f->bar(undef);
  63 };
  64 ok !$@;
  65 is $f->bar, undef, 'bar is undef';
  66
  67
  68 {
  69     package Bar;
  70     use Mouse;
  71     BEGIN { Types->import(qw( Type1 Type2 )) }
  72     has 'foo' => ( is => 'rw', isa => Type1 | Type2 , coerce => 1 );
  73 }
  74
  75 my $foo = Bar->new( foo => 'aaa' );
  76 ok $foo, 'got an object 3';
  77 is $foo->foo, 'Name', 'foo is Name';