t/001_mouse/810-isa-or.t

   1 #!perl
   2
   3 # XXX:
   4 # XXX: !!!Currently this test is not compatible with Moose!!!
   5 # XXX:
   6
   7 use strict;
   8 use warnings;
   9 use Test::More tests => 22;
  10
  11 {
  12     package Foo;
  13     use Mouse;
  14     use Mouse::Util::TypeConstraints;
  15     type Baz => where { defined($_) && $_ eq 'Baz' };
  16
  17     coerce Baz => from 'ArrayRef', via { 'Baz' };
  18
  19     has 'bar' => ( is => 'rw', isa => 'Str | Baz | Undef', coerce => 1 );
  20 }
  21
  22 eval {
  23     Foo->new( bar => +{} );
  24 };
  25 like($@, qr/^Attribute \(bar\) does not pass the type constraint because: Validation failed for 'Baz\|Str\|Undef' failed with value HASH\(\w+\)/, 'type constraint and coercion failed')
  26     or diag "\$@='$@'";
  27
  28 eval {
  29     isa_ok(Foo->new( bar => undef ), 'Foo');
  30 };
  31 ok !$@, 'got an object 1';
  32
  33 eval {
  34     isa_ok(Foo->new( bar => 'foo' ), 'Foo');
  35
  36 };
  37 ok !$@, 'got an object 2';
  38
  39
  40 my $f = Foo->new;
  41 eval {
  42     $f->bar([]);
  43 };
  44 ok !$@, $@;
  45 is $f->bar, 'Baz', 'bar is baz (coerce from ArrayRef)';
  46
  47 eval {
  48     $f->bar('hoge');
  49 };
  50 ok !$@;
  51 is $f->bar, 'hoge', 'bar is hoge';
  52
  53 eval {
  54     $f->bar(undef);
  55 };
  56 ok !$@;
  57 is $f->bar, undef, 'bar is undef';
  58
  59
  60 {
  61     package Bar;
  62     use Mouse;
  63     use Mouse::Util::TypeConstraints;
  64
  65     type 'Type1' => where { defined($_) && $_ eq 'Name' };
  66     coerce 'Type1', from 'Str', via { 'Names' };
  67
  68     type 'Type2' => where { defined($_) && $_ eq 'Group' };
  69     coerce 'Type2', from 'Str', via { 'Name' };
  70
  71     has 'foo' => ( is => 'rw', isa => 'Type1|Type2', coerce => 1 );
  72 }
  73
  74 my $foo = Bar->new( foo => 'aaa' );
  75 ok $foo, 'got an object 3';
  76 is $foo->foo, 'Name', 'foo is Name';
  77
  78
  79 {
  80     package KLASS;
  81     use Mouse;
  82 }
  83 {
  84     package Funk;
  85     use Mouse;
  86     use Mouse::Util::TypeConstraints;
  87
  88     type 'Type3' => where { defined($_) && $_ eq 'Name' };
  89     coerce 'Type3', from 'CodeRef', via { 'Name' };
  90
  91     has 'foo' => ( is => 'rw', isa => 'Type3|KLASS|Undef', coerce => 1 );
  92 }
  93
  94 eval { Funk->new( foo => 'aaa' ) };
  95 like $@, qr/Attribute \(foo\) does not pass the type constraint because: Validation failed for 'KLASS\|Type3\|Undef' failed with value aaa/;
  96
  97 my $k = Funk->new;
  98 ok $k, 'got an object 4';
  99 $k->foo(sub {});
 100 is $k->foo, 'Name', 'foo is Name';
 101 $k->foo(KLASS->new);
 102 isa_ok $k->foo, 'KLASS';
 103 $k->foo(undef);
 104 is $k->foo, undef, 'foo is undef';
 105
 106 # or-combination operator ('|')
 107 {
 108     use Mouse::Util::TypeConstraints;
 109     my $Int    = find_type_constraint 'Int';
 110     my $Str    = find_type_constraint 'Str';
 111     my $Object = find_type_constraint 'Object';
 112
 113     *t = \&Mouse::Util::TypeConstraints::find_or_parse_type_constraint; # alias
 114
 115     is $Int | $Str, t('Int | Str');
 116     is $Str | $Int, t('Int | Str');
 117
 118     is $Int | $Str | $Object, t('Int | Str | Object');
 119     is $Str | $Object | $Int, t('Int | Str | Object');
 120 }
 121