t/09-optional.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests=>46;
   5 use Test::Fatal;
   6 use Moose::Util::TypeConstraints;
   7 use MooseX::Types::Structured qw(Optional);
   8
   9 APITEST: {
  10
  11     ok my $Optional = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MooseX::Types::Structured::Optional')
  12      => 'Got Optional';
  13
  14     isa_ok $Optional
  15      => 'Moose::Meta::TypeConstraint::Parameterizable';
  16
  17     ok my $int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Int')
  18      => 'Got Int';
  19
  20     ok my $arrayref = Moose::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int]')
  21      => 'Got ArrayRef[Int]';
  22
  23     BASIC: {
  24         ok my $Optional_Int = $Optional->parameterize($int), 'Parameterized Int';
  25         ok my $Optional_ArrayRef = $Optional->parameterize($arrayref), 'Parameterized ArrayRef';
  26
  27         ok $Optional_Int->check() => 'Optional is allowed to not exist';
  28
  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"';
  32
  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"]';
  38     }
  39
  40     SUBREF: {
  41         ok my $Optional_Int = Optional->parameterize($int),'Parameterized Int';
  42         ok my $Optional_ArrayRef = Optional->parameterize($arrayref), 'Parameterized ArrayRef';
  43
  44         ok $Optional_Int->check() => 'Optional is allowed to not exist';
  45
  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"';
  49
  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"]';
  55     }
  56 }
  57
  58 OBJECTTEST: {
  59     package Test::MooseX::Meta::TypeConstraint::Structured::Optional;
  60
  61     use Moose;
  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
  66     )];
  67
  68     subtype MoreThanFive,
  69      as Int,
  70      where { $_ > 5};
  71
  72     enum Gender,
  73      qw/male female transgendered/;
  74
  75     subtype TupleOptional1() =>
  76         as Tuple[Int, MoreThanFive, Optional[Str|Object]];
  77
  78     subtype TupleOptional2,
  79         as Tuple[Int, MoreThanFive, Optional[HashRef[Int|Object]]];
  80
  81     subtype DictOptional1,
  82         as Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
  83
  84     subtype Insane,
  85         as Tuple[
  86             Int,
  87             Optional[Str|Object],
  88             DictOptional1,
  89             Optional[ArrayRef[Int]]
  90         ];
  91
  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);
  96 }
  97
  98 ok my $obj = Test::MooseX::Meta::TypeConstraint::Structured::Optional->new
  99  => 'Instantiated new test class.';
 100
 101 isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Optional'
 102  => 'Created correct object type.';
 103
 104 # Test Insane
 105
 106 is( exception {
 107     $obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]);
 108 } => undef, 'Set InsaneAttr attribute without error [1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]');
 109
 110 is( exception {
 111     $obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[1,2,3]]);
 112 } => undef, 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39},[1,2,3]]');
 113
 114 is( exception {
 115     $obj->InsaneAttr([1,$obj,{name=>"John",age=>39}]);
 116 } => undef, 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39}]');
 117
 118 like( exception {
 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/]]});
 122
 123 like( exception {
 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]]});
 127
 128 # Test TupleOptional1Attr
 129
 130 is( exception {
 131     $obj->TupleOptional1Attr([1,10,"hello"]);
 132 } => undef, 'Set TupleOptional1Attr attribute without error [1,10,"hello"]');
 133
 134 is( exception {
 135     $obj->TupleOptional1Attr([1,10,$obj]);
 136 } => undef, 'Set TupleOptional1Attr attribute without error [1,10,$obj]');
 137
 138 is( exception {
 139     $obj->TupleOptional1Attr([1,10]);
 140 } => undef, 'Set TupleOptional1Attr attribute without error [1,10]');
 141
 142 like( exception {
 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]]});
 146
 147 like( exception {
 148     $obj->TupleOptional1Attr([1,10,undef]);
 149 }, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
 150  => q{TupleOptional1Attr correctly fails [1,10,undef]});
 151
 152 # Test TupleOptional2Attr
 153
 154 is( exception {
 155     $obj->TupleOptional2Attr([1,10,{key1=>1,key2=>$obj}]);
 156 } => undef, 'Set TupleOptional2Attr attribute without error [1,10,{key1=>1,key2=>$obj}]');
 157
 158 is( exception {
 159     $obj->TupleOptional2Attr([1,10]);
 160 } => undef, 'Set TupleOptional2Attr attribute without error [1,10]');
 161
 162 like( exception {
 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]]});
 166
 167 like( exception {
 168     $obj->TupleOptional2Attr([1,10,undef]);
 169 }, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
 170  => q{TupleOptional2Attr correctly fails [1,10,undef]});
 171
 172 # Test DictOptional1Attr: Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
 173
 174 is( exception {
 175     $obj->DictOptional1Attr({name=>"John",age=>39,gender=>"male"});
 176 } => undef, 'Set DictOptional1Attr attribute without error {name=>"John",age=>39,gender=>"male"}');
 177
 178 is( exception {
 179     $obj->DictOptional1Attr({name=>"Vanessa",age=>34});
 180 } => undef, 'Set DictOptional1Attr attribute without error {name=>"Vanessa",age=>34}');
 181
 182 like( exception {
 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}});
 186
 187 like( exception {
 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"}});