Commit | Line | Data |
896f108d |
1 | BEGIN { |
2 | use strict; |
3 | use warnings; |
67a8bc04 |
4 | use Test::More tests=>16; |
896f108d |
5 | use Test::Exception; |
6 | } |
7 | |
8 | { |
9 | package Test::MooseX::Meta::TypeConstraint::Structured::Advanced; |
10 | |
11 | use Moose; |
12 | use MooseX::Types::Structured qw(Dict Tuple); |
13 | use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe); |
14 | use MooseX::Types -declare => [qw( |
15 | EqualLength MoreThanFive MoreLengthPlease PersonalInfo MorePersonalInfo |
16 | MinFiveChars |
17 | )]; |
18 | |
19 | subtype MoreThanFive, |
20 | as Int, |
21 | where { $_ > 5}; |
22 | |
23 | ## Tuple contains two equal length Arrays |
24 | subtype EqualLength, |
25 | as Tuple[ArrayRef[MoreThanFive],ArrayRef[MoreThanFive]], |
26 | where { $#{$_->[0]} == $#{$_->[1]} }; |
27 | |
28 | ## subclass the complex tuple |
29 | subtype MoreLengthPlease, |
30 | as EqualLength, |
31 | where { $#{$_->[0]} >= 4}; |
32 | |
33 | ## Complexe Dict |
34 | subtype PersonalInfo, |
35 | as Dict[name=>Str, stats=>MoreLengthPlease|Object]; |
36 | |
37 | ## Minimum 5 char string |
38 | subtype MinFiveChars, |
39 | as Str, |
40 | where { length($_) > 5}; |
67a8bc04 |
41 | |
896f108d |
42 | ## Dict key overloading |
43 | subtype MorePersonalInfo, |
686da114 |
44 | # as PersonalInfo[name=>MinFiveChars]; |
45 | as PersonalInfo; |
896f108d |
46 | |
47 | has 'EqualLengthAttr' => (is=>'rw', isa=>EqualLength); |
48 | has 'MoreLengthPleaseAttr' => (is=>'rw', isa=>MoreLengthPlease); |
49 | has 'PersonalInfoAttr' => (is=>'rw', isa=>PersonalInfo); |
50 | has 'MorePersonalInfo' => (is=>'rw', isa=>MorePersonalInfo); |
51 | } |
52 | |
53 | ## Instantiate a new test object |
54 | |
55 | ok my $obj = Test::MooseX::Meta::TypeConstraint::Structured::Advanced->new |
56 | => 'Instantiated new Record test class.'; |
57 | |
58 | isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Advanced' |
59 | => 'Created correct object type.'; |
67a8bc04 |
60 | |
896f108d |
61 | ## Test EqualLengthAttr |
62 | |
63 | lives_ok sub { |
64 | $obj->EqualLengthAttr([[6,7,8],[9,10,11]]); |
65 | } => 'Set EqualLengthAttr attribute without error'; |
66 | |
67 | throws_ok sub { |
68 | $obj->EqualLengthAttr([1,'hello', 'test.xxx.test']); |
69 | }, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/ |
70 | => q{EqualLengthAttr correctly fails [1,'hello', 'test.xxx.test']}; |
71 | |
72 | throws_ok sub { |
73 | $obj->EqualLengthAttr([[6,7],[9,10,11]]); |
74 | }, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/ |
75 | => q{EqualLengthAttr correctly fails [[6,7],[9,10,11]]}; |
76 | |
77 | throws_ok sub { |
78 | $obj->EqualLengthAttr([[6,7,1],[9,10,11]]); |
79 | }, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/ |
80 | => q{EqualLengthAttr correctly fails [[6,7,1],[9,10,11]]}; |
81 | |
82 | ## Test MoreLengthPleaseAttr |
83 | |
84 | lives_ok sub { |
85 | $obj->MoreLengthPleaseAttr([[6,7,8,9,10],[11,12,13,14,15]]); |
86 | } => 'Set MoreLengthPleaseAttr attribute without error'; |
87 | |
88 | throws_ok sub { |
89 | $obj->MoreLengthPleaseAttr([[6,7,8,9],[11,12,13,14]]); |
90 | }, qr/Attribute \(MoreLengthPleaseAttr\) does not pass the type constraint/ |
91 | => q{MoreLengthPleaseAttr correctly fails [[6,7,8,9],[11,12,13,14]]}; |
92 | |
93 | ## Test PersonalInfoAttr |
94 | |
95 | lives_ok sub { |
96 | $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); |
67a8bc04 |
97 | } => 'Set PersonalInfoAttr attribute without error 1'; |
896f108d |
98 | |
99 | lives_ok sub { |
100 | $obj->PersonalInfoAttr({name=>'John', stats=>$obj}); |
67a8bc04 |
101 | } => 'Set PersonalInfoAttr attribute without error 2'; |
896f108d |
102 | |
103 | throws_ok sub { |
104 | $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]}); |
105 | }, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/ |
106 | => q{PersonalInfoAttr correctly fails name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]}; |
107 | |
108 | throws_ok sub { |
109 | $obj->PersonalInfoAttr({name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); |
110 | }, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/ |
111 | => q{PersonalInfoAttr correctly fails name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}; |
112 | |
67a8bc04 |
113 | ## Test MorePersonalInfo |
114 | |
115 | lives_ok sub { |
116 | $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); |
117 | } => 'Set MorePersonalInfo attribute without error 1'; |
118 | |
119 | throws_ok sub { |
120 | $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]}); |
121 | }, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/ |
122 | => q{MorePersonalInfo correctly fails name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]}; |
123 | |
124 | throws_ok sub { |
125 | $obj->MorePersonalInfo({name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); |
126 | }, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/ |
127 | => q{MorePersonalInfo correctly fails name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}; |
128 | |
129 | SKIP: { |
130 | skip 'not yet working', 1; |
131 | |
132 | throws_ok sub { |
133 | $obj->MorePersonalInfo({name=>'abc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); |
134 | }, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/ |
135 | => q{MorePersonalInfo correctly fails name=>'aaa', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}; |
136 | } |
896f108d |
137 | |