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