4 # XXX: !!!Currently this test is not compatible with Moose!!!
9 use Test::More tests => 22;
14 use Mouse::Util::TypeConstraints;
15 type Baz => where { defined($_) && $_ eq 'Baz' };
17 coerce Baz => from 'ArrayRef', via { 'Baz' };
19 has 'bar' => ( is => 'rw', isa => 'Str | Baz | Undef', coerce => 1 );
23 Foo->new( bar => +{} );
25 like($@, qr/^Attribute \(bar\) does not pass the type constraint because: Validation failed for 'Baz\|Str\|Undef' with value HASH\(\w+\)/, 'type constraint and coercion failed')
29 isa_ok(Foo->new( bar => undef ), 'Foo');
31 ok !$@, 'got an object 1';
34 isa_ok(Foo->new( bar => 'foo' ), 'Foo');
37 ok !$@, 'got an object 2';
45 is $f->bar, 'Baz', 'bar is baz (coerce from ArrayRef)';
51 is $f->bar, 'hoge', 'bar is hoge';
57 is $f->bar, undef, 'bar is undef';
63 use Mouse::Util::TypeConstraints;
65 type 'Type1' => where { defined($_) && $_ eq 'Name' };
66 coerce 'Type1', from 'Str', via { 'Names' };
68 type 'Type2' => where { defined($_) && $_ eq 'Group' };
69 coerce 'Type2', from 'Str', via { 'Name' };
71 has 'foo' => ( is => 'rw', isa => 'Type1|Type2', coerce => 1 );
74 my $foo = Bar->new( foo => 'aaa' );
75 ok $foo, 'got an object 3';
76 is $foo->foo, 'Name', 'foo is Name';
86 use Mouse::Util::TypeConstraints;
88 type 'Type3' => where { defined($_) && $_ eq 'Name' };
89 coerce 'Type3', from 'CodeRef', via { 'Name' };
91 has 'foo' => ( is => 'rw', isa => 'Type3|KLASS|Undef', coerce => 1 );
94 eval { Funk->new( foo => 'aaa' ) };
95 like $@, qr/Attribute \(foo\) does not pass the type constraint because: Validation failed for 'KLASS\|Type3\|Undef' with value aaa/;
98 ok $k, 'got an object 4';
100 is $k->foo, 'Name', 'foo is Name';
102 isa_ok $k->foo, 'KLASS';
104 is $k->foo, undef, 'foo is undef';
106 # or-combination operator ('|')
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';
113 *t = \&Mouse::Util::TypeConstraints::find_or_parse_type_constraint; # alias
115 is $Int | $Str, t('Int | Str');
116 is $Str | $Int, t('Int | Str');
118 is $Int | $Str | $Object, t('Int | Str | Object');
119 is $Str | $Object | $Int, t('Int | Str | Object');