Commit | Line | Data |
6da1e936 |
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 | subtype Baz, where { defined($_) && $_ eq 'Baz' }; |
13 | coerce Baz, from ArrayRef, via { 'Baz' }; |
14 | |
15 | subtype Type1, where { defined($_) && $_ eq 'Name' }; |
16 | coerce Type1, from 'Str', via { 'Names' }; |
17 | |
18 | subtype 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'; |