4 use Test::More tests=>46;
6 use Moose::Util::TypeConstraints;
7 use MooseX::Types::Structured qw(Optional);
11 ok my $Optional = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MooseX::Types::Structured::Optional')
15 => 'Moose::Meta::TypeConstraint::Parameterizable';
17 ok my $int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Int')
20 ok my $arrayref = Moose::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int]')
21 => 'Got ArrayRef[Int]';
24 ok my $Optional_Int = $Optional->parameterize($int), 'Parameterized Int';
25 ok my $Optional_ArrayRef = $Optional->parameterize($arrayref), 'Parameterized ArrayRef';
27 ok $Optional_Int->check() => 'Optional is allowed to not exist';
29 ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
30 ok $Optional_Int->check(199) => 'Correctly validates 199';
31 ok !$Optional_Int->check("a") => 'Correctly fails "a"';
33 ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
34 ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
35 ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
36 ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
37 ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';
41 ok my $Optional_Int = Optional->parameterize($int),'Parameterized Int';
42 ok my $Optional_ArrayRef = Optional->parameterize($arrayref), 'Parameterized ArrayRef';
44 ok $Optional_Int->check() => 'Optional is allowed to not exist';
46 ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
47 ok $Optional_Int->check(199) => 'Correctly validates 199';
48 ok !$Optional_Int->check("a") => 'Correctly fails "a"';
50 ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
51 ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
52 ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
53 ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
54 ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';
59 package Test::MooseX::Meta::TypeConstraint::Structured::Optional;
62 use MooseX::Types::Structured qw(Dict Tuple Optional);
63 use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
64 use MooseX::Types -declare => [qw(
65 MoreThanFive TupleOptional1 TupleOptional2 Gender DictOptional1 Insane
73 qw/male female transgendered/;
75 subtype TupleOptional1() =>
76 as Tuple[Int, MoreThanFive, Optional[Str|Object]];
78 subtype TupleOptional2,
79 as Tuple[Int, MoreThanFive, Optional[HashRef[Int|Object]]];
81 subtype DictOptional1,
82 as Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
89 Optional[ArrayRef[Int]]
92 has 'TupleOptional1Attr' => (is=>'rw', isa=>TupleOptional1);
93 has 'TupleOptional2Attr' => (is=>'rw', isa=>TupleOptional2);
94 has 'DictOptional1Attr' => (is=>'rw', isa=>DictOptional1);
95 has 'InsaneAttr' => (is=>'rw', isa=>Insane);
98 ok my $obj = Test::MooseX::Meta::TypeConstraint::Structured::Optional->new
99 => 'Instantiated new test class.';
101 isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Optional'
102 => 'Created correct object type.';
107 $obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]);
108 } => 'Set InsaneAttr attribute without error [1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]';
111 $obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[1,2,3]]);
112 } => 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39},[1,2,3]]';
115 $obj->InsaneAttr([1,$obj,{name=>"John",age=>39}]);
116 } => 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39}]';
119 $obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[qw/a b c/]]);
120 }, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
121 => q{InsaneAttr correctly fails [1,$obj,{name=>"John",age=>39},[qw/a b c/]]};
124 $obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]);
125 }, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
126 => q{InsaneAttr correctly fails [1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]};
128 # Test TupleOptional1Attr
131 $obj->TupleOptional1Attr([1,10,"hello"]);
132 } => 'Set TupleOptional1Attr attribute without error [1,10,"hello"]';
135 $obj->TupleOptional1Attr([1,10,$obj]);
136 } => 'Set TupleOptional1Attr attribute without error [1,10,$obj]';
139 $obj->TupleOptional1Attr([1,10]);
140 } => 'Set TupleOptional1Attr attribute without error [1,10]';
143 $obj->TupleOptional1Attr([1,10,[1,2,3]]);
144 }, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
145 => q{TupleOptional1Attr correctly fails [1,10,[1,2,3]]};
148 $obj->TupleOptional1Attr([1,10,undef]);
149 }, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
150 => q{TupleOptional1Attr correctly fails [1,10,undef]};
152 # Test TupleOptional2Attr
155 $obj->TupleOptional2Attr([1,10,{key1=>1,key2=>$obj}]);
156 } => 'Set TupleOptional2Attr attribute without error [1,10,{key1=>1,key2=>$obj}]';
159 $obj->TupleOptional2Attr([1,10]);
160 } => 'Set TupleOptional2Attr attribute without error [1,10]';
163 $obj->TupleOptional2Attr([1,10,[1,2,3]]);
164 }, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
165 => q{TupleOptional2Attr correctly fails [1,10,[1,2,3]]};
168 $obj->TupleOptional2Attr([1,10,undef]);
169 }, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
170 => q{TupleOptional2Attr correctly fails [1,10,undef]};
172 # Test DictOptional1Attr: Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
175 $obj->DictOptional1Attr({name=>"John",age=>39,gender=>"male"});
176 } => 'Set DictOptional1Attr attribute without error {name=>"John",age=>39,gender=>"male"}';
179 $obj->DictOptional1Attr({name=>"Vanessa",age=>34});
180 } => 'Set DictOptional1Attr attribute without error {name=>"Vanessa",age=>34}';
183 $obj->DictOptional1Attr({name=>"John",age=>39,gender=>undef});
184 }, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
185 => q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>undef}};
188 $obj->DictOptional1Attr({name=>"John",age=>39,gender=>"aaa"});
189 }, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
190 => q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>"aaa"}};