Commit | Line | Data |
c81443cb |
1 | BEGIN { |
8dbdca20 |
2 | use strict; |
3 | use warnings; |
4 | use Test::More tests=>16; |
5 | use Test::Exception; |
c81443cb |
6 | } |
7 | |
8 | { |
9 | package Test::MooseX::Meta::TypeConstraint::Structured::Coerce; |
10 | |
11 | use Moose; |
12 | use MooseX::Types::Structured qw(Dict Tuple); |
8dbdca20 |
13 | use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef); |
14 | use MooseX::Types -declare => [qw( |
16aea7bf |
15 | myDict myTuple Fullname |
c81443cb |
16 | |
17 | )]; |
8dbdca20 |
18 | |
16aea7bf |
19 | subtype myDict, |
20 | as Dict[name=>Str, age=>Int]; |
8dbdca20 |
21 | |
16aea7bf |
22 | subtype Fullname, |
23 | as Dict[first=>Str, last=>Str]; |
8dbdca20 |
24 | |
16aea7bf |
25 | coerce Fullname, |
26 | from ArrayRef, |
27 | via { +{first=>$_->[0], last=>$_->[1]} }; |
8dbdca20 |
28 | |
16aea7bf |
29 | subtype myTuple, |
30 | as Tuple[Str, Int]; |
c81443cb |
31 | |
16aea7bf |
32 | ## Create some coercions. Note the dob_epoch could be a more useful convert |
33 | ## from a dob datetime object, I'm just lazy. |
8dbdca20 |
34 | |
16aea7bf |
35 | coerce myDict, |
36 | from Int, |
37 | via { +{name=>'JohnDoe', age=>$_} }, |
38 | from Dict[aname=>HashRef, dob_in_years=>Int], |
39 | via { +{ |
40 | name=> $_->{aname}->{first} .' '. $_->{aname}->{last}, |
41 | age=>$_->{dob_in_years}, |
42 | } |
43 | }, |
44 | from Dict[bname=>HashRef, dob_in_years=>Int], |
45 | via { +{ |
46 | name=> $_->{bname}->{first} .' '. $_->{bname}->{last}, |
47 | age=>$_->{dob_in_years}, |
48 | } |
49 | }, |
50 | from Dict[fullname=>Fullname, dob_epoch=>Int], |
51 | via { +{ |
52 | name=> $_->{fullname}->{first} .' '. $_->{fullname}->{last}, |
53 | age=>$_->{dob_epoch}} |
54 | }, |
55 | from myTuple, |
56 | via { +{name=>$_->[0], age=>$_->[1]} }; |
57 | |
58 | has 'stuff' => (is=>'rw', isa=>myDict, coerce=>1); |
c81443cb |
59 | } |
60 | |
16aea7bf |
61 | ## Create an object to test |
62 | |
63 | ok my $person = Test::MooseX::Meta::TypeConstraint::Structured::Coerce->new(); |
64 | isa_ok $person, 'Test::MooseX::Meta::TypeConstraint::Structured::Coerce';## Try out the coercions |
65 | |
66 | ok $person->stuff({name=>"John",age=>25}), 'Set Stuff {name=>"John",age=>25}'; |
67 | is_deeply $person->stuff, {name=>"John",age=>25}, 'Correct set'; |
68 | |
69 | ok $person->stuff(30), 'Set Stuff 30'; |
70 | is_deeply $person->stuff, {name=>"JohnDoe",age=>30}, 'Correct set'; |
71 | |
72 | ok $person->stuff({aname=>{first=>"frank", last=>"herbert"},dob_in_years=>80}), |
73 | '{{first=>"frank", last=>"herbert"},80}'; |
8dbdca20 |
74 | |
16aea7bf |
75 | is_deeply $person->stuff, {name=>"frank herbert",age=>80}, 'Correct set'; |
c81443cb |
76 | |
16aea7bf |
77 | ok $person->stuff({bname=>{first=>"frankbbb", last=>"herbert"},dob_in_years=>84}), |
78 | '{{first=>"frankbbb", last=>"herbert"},84}'; |
8dbdca20 |
79 | |
16aea7bf |
80 | is_deeply $person->stuff, {name=>"frankbbb herbert",age=>84}, 'Correct set'; |
81 | |
82 | ok $person->stuff(["mary",40]), 'Set Stuff ["mary",40]'; |
83 | is_deeply $person->stuff, {name=>"mary",age=>40}, 'Correct set'; |
84 | |
85 | ok $person->stuff({fullname=>{first=>"frank", last=>"herbert1"},dob_epoch=>85}), |
86 | '{{first=>"frank", last=>"herbert1"},85}'; |
8dbdca20 |
87 | |
16aea7bf |
88 | is_deeply $person->stuff, {name=>"frank herbert1",age=>85}, 'Correct set'; |
89 | |
90 | SKIP: { |
91 | skip 'deep coercions not yet supported', 2, 1; |
8dbdca20 |
92 | |
16aea7bf |
93 | ok $person->stuff({fullname=>["frank", "herbert2"],dob_epoch=>86}), |
94 | '{fullname=>["frank", "herbert2"],dob_epoch=>86}'; |
8dbdca20 |
95 | |
96 | is_deeply $person->stuff, {name=>"frank herbert2",age=>86}, 'Correct set'; |
16aea7bf |
97 | } |
c81443cb |
98 | |
99 | |