t/800_shikabased/010-isa-or.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 18;
   4
   5 {
   6     package Foo;
   7     use Mouse;
   8     use Mouse::Util::TypeConstraints;
   9     type Baz => where { defined($_) && $_ eq 'Baz' };
  10
  11     coerce Baz => from 'ArrayRef', via { 'Baz' };
  12
  13     has 'bar' => ( is => 'rw', isa => 'Str | Baz | Undef', coerce => 1 );
  14 }
  15
  16 eval {
  17     Foo->new( bar => +{} );
  18 };
  19 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')
  20     or diag "\$@='$@'";
  21
  22 eval {
  23     isa_ok(Foo->new( bar => undef ), 'Foo');
  24 };
  25 ok !$@, 'got an object 1';
  26
  27 eval {
  28     isa_ok(Foo->new( bar => 'foo' ), 'Foo');
  29
  30 };
  31 ok !$@, 'got an object 2';
  32
  33
  34 my $f = Foo->new;
  35 eval {
  36     $f->bar([]);
  37 };
  38 ok !$@, $@;
  39 is $f->bar, 'Baz', 'bar is baz (coerce from ArrayRef)';
  40
  41 eval {
  42     $f->bar('hoge');
  43 };
  44 ok !$@;
  45 is $f->bar, 'hoge', 'bar is hoge';
  46
  47 eval {
  48     $f->bar(undef);
  49 };
  50 ok !$@;
  51 is $f->bar, undef, 'bar is undef';
  52
  53
  54 {
  55     package Bar;
  56     use Mouse;
  57     use Mouse::Util::TypeConstraints;
  58
  59     type 'Type1' => where { defined($_) && $_ eq 'Name' };
  60     coerce 'Type1', from 'Str', via { 'Names' };
  61
  62     type 'Type2' => where { defined($_) && $_ eq 'Group' };
  63     coerce 'Type2', from 'Str', via { 'Name' };
  64
  65     has 'foo' => ( is => 'rw', isa => 'Type1|Type2', coerce => 1 );
  66 }
  67
  68 my $foo = Bar->new( foo => 'aaa' );
  69 ok $foo, 'got an object 3';
  70 is $foo->foo, 'Name', 'foo is Name';
  71
  72
  73 {
  74     package KLASS;
  75     use Mouse;
  76 }
  77 {
  78     package Funk;
  79     use Mouse;
  80     use Mouse::Util::TypeConstraints;
  81
  82     type 'Type3' => where { defined($_) && $_ eq 'Name' };
  83     coerce 'Type3', from 'CodeRef', via { 'Name' };
  84
  85     has 'foo' => ( is => 'rw', isa => 'Type3|KLASS|Undef', coerce => 1 );
  86 }
  87
  88 eval { Funk->new( foo => 'aaa' ) };
  89 like $@, qr/Attribute \(foo\) does not pass the type constraint because: Validation failed for 'KLASS\|Type3\|Undef' failed with value aaa/;
  90
  91 my $k = Funk->new;
  92 ok $k, 'got an object 4';
  93 $k->foo(sub {});
  94 is $k->foo, 'Name', 'foo is Name';
  95 $k->foo(KLASS->new);
  96 isa_ok $k->foo, 'KLASS';
  97 $k->foo(undef);
  98 is $k->foo, undef, 'foo is undef';
  99