t/constraints.t

   1 BEGIN {
   2         use strict;
   3         use warnings;
   4         use Test::More tests=>42;
   5         use Test::Exception;
   6 }
   7
   8 {
   9     package Test::MooseX::Meta::TypeConstraint::Structured;
  10
  11     use Moose;
  12     use Moose::Util::TypeConstraints;
  13     use MooseX::Meta::TypeConstraint::Structured::Named;
  14     use MooseX::Meta::TypeConstraint::Structured::Positional;
  15
  16     subtype 'MyString',
  17      as 'Str',
  18      where { $_=~m/abc/};
  19
  20     sub Tuple {
  21         my ($args, $optional) = @_;
  22         my @args = @$args;
  23         my @optional = ref $optional eq 'ARRAY' ? @$optional : ();
  24
  25         return MooseX::Meta::TypeConstraint::Structured::Positional->new(
  26             name => 'Tuple',
  27             parent => find_type_constraint('ArrayRef'),
  28             package_defined_in => __PACKAGE__,
  29             signature => [map {
  30                                 _normalize_type_constraint($_);
  31                         } @args],
  32             optional_signature => [map {
  33                                 _normalize_type_constraint($_);
  34                         } @optional],
  35         );
  36     }
  37
  38     sub Dict {
  39         my ($args, $optional) = @_;
  40         my %args = @$args;
  41         my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
  42
  43         return MooseX::Meta::TypeConstraint::Structured::Named->new(
  44             name => 'Dict',
  45             parent => find_type_constraint('HashRef'),
  46             package_defined_in => __PACKAGE__,
  47             signature => {map {
  48                                 $_ => _normalize_type_constraint($args{$_});
  49                         } keys %args},
  50             optional_signature => {map {
  51                                 $_ => _normalize_type_constraint($optional{$_});
  52                         } keys %optional},
  53         );
  54     }
  55
  56         sub _normalize_type_constraint {
  57                 my $tc = shift @_;
  58                 if(defined $tc && blessed $tc && $tc->isa('Moose::Meta::TypeConstraint')) {
  59                         return $tc;
  60                 } elsif($tc) {
  61                         return Moose::Util::TypeConstraints::find_or_parse_type_constraint($tc);
  62                 }
  63         }
  64
  65     has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
  66     has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
  67     has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']);
  68         has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
  69         has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
  70         has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
  71     has 'optional_tuple' => (is=>'rw', isa=>Tuple(['Int', 'Int'],['Int']) );
  72     has 'optional_dict' => (is=>'rw', isa=>Dict([key1=>'Int'],[key2=>'Int']) );
  73
  74     has 'crazy' => (
  75         is=>'rw',
  76         isa=>Tuple(
  77             ## First ArrayRef Arg is the required type constraints for the top
  78             ## level Tuple.
  79             [
  80                 'Int',
  81                 'MyString',
  82                 ## The third required element is a Dict type constraint, which
  83                 ## itself has two required keys and a third optional key.
  84                 Dict([name=>'Str',age=>'Int'],[visits=>'Int'])
  85             ],
  86             ## Second ArrayRef Arg defines the optional constraints for the top
  87             ## level Tuple.
  88             [
  89                 'Int',
  90                 ## This Tuple has one required type constraint and two optional.
  91                 Tuple(
  92                       ['Int'],
  93                       ['Int','HashRef'],
  94                 ),
  95             ],
  96         )
  97     );
  98 }
  99
 100 ## Instantiate a new test object
 101
 102 ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
 103  => 'Instantiated new Record test class.';
 104
 105 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
 106  => 'Created correct object type.';
 107
 108 ## Test crazy
 109
 110 lives_ok sub {
 111     $record->crazy([1,'hello.abc.world', {name=>'John', age=>39}]);
 112 } => 'Set crazy attribute with no optionals used';
 113
 114 is_deeply $record->crazy, [1, 'hello.abc.world', {name=>'John', age=>39}]
 115  => 'correct values for crazy attributes no optionals';
 116
 117 lives_ok sub {
 118     $record->crazy([1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]);
 119 } => 'Set crazy attribute with all optionals used';
 120
 121 is_deeply $record->crazy, [1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]
 122  => 'correct values for crazy attributes all optionals';
 123
 124 lives_ok sub {
 125     $record->crazy([1,'hello.abc.world', {name=>'John', age=>39},10, [1,2]]);
 126 } => 'Set crazy attribute with some optionals used';
 127
 128 throws_ok sub {
 129     $record->crazy([1,'hello', 'test.xxx.test']);
 130 }, qr/Validation failed for 'MyString'/
 131  => 'Properly failed for bad value in crazy attribute 01';
 132
 133 throws_ok sub {
 134     $record->crazy([1,'hello.abc.world', {notname=>'John', notage=>39}]);
 135 }, qr/Validation failed for 'Str'/
 136  => 'Properly failed for bad value in crazy attribute 02';
 137
 138 ## Test Tuple type constraint
 139
 140 lives_ok sub {
 141     $record->tuple([1,'hello', 'test.abc.test']);
 142 } => 'Set tuple attribute without error';
 143
 144 is $record->tuple->[0], 1
 145  => 'correct set the tuple attribute index 0';
 146
 147 is $record->tuple->[1], 'hello'
 148  => 'correct set the tuple attribute index 1';
 149
 150 is $record->tuple->[2], 'test.abc.test'
 151  => 'correct set the tuple attribute index 2';
 152
 153 throws_ok sub {
 154     $record->tuple([1,'hello', 'test.xxx.test']);
 155 }, qr/Validation failed for 'MyString'/
 156  => 'Properly failed for bad value in custom type constraint';
 157
 158 throws_ok sub {
 159     $record->tuple(['asdasd',2, 'test.abc.test']);
 160 }, qr/Validation failed for 'Int'/
 161  => 'Got Expected Error for violating constraints';
 162
 163 ## Test the Dictionary type constraint
 164
 165 lives_ok sub {
 166     $record->dict({name=>'frith', age=>23});
 167 } => 'Set dict attribute without error';
 168
 169 is $record->dict->{name}, 'frith'
 170  => 'correct set the dict attribute name';
 171
 172 is $record->dict->{age}, 23
 173  => 'correct set the dict attribute age';
 174
 175 throws_ok sub {
 176     $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
 177 }, qr/Validation failed for 'Str'/
 178  => 'Got Expected Error for bad value in dict';
 179
 180 ## Test tuple_with_maybe
 181
 182 lives_ok sub {
 183     $record->tuple_with_maybe([1,'hello', 1]);
 184 } => 'Set tuple attribute without error';
 185
 186 throws_ok sub {
 187     $record->tuple_with_maybe([1,'hello', 'a']);
 188 }, qr/Validation failed for 'Maybe\[Int\]'/
 189  => 'Properly failed for bad value parameterized constraint';
 190
 191 lives_ok sub {
 192     $record->tuple_with_maybe([1,'hello']);
 193 } => 'Set tuple attribute without error skipping optional parameter';
 194
 195 ## Test Tuple with parameterized type
 196
 197 lives_ok sub {
 198     $record->tuple_with_param([1,'hello', [1,2,3]]);
 199 } => 'Set tuple attribute without error';
 200
 201 throws_ok sub {
 202     $record->tuple_with_param([1,'hello', [qw/a b c/]]);
 203 }, qr/Validation failed for 'ArrayRef\[Int\]'/
 204  => 'Properly failed for bad value parameterized constraint';
 205
 206 ## Test dict_with_maybe
 207
 208 lives_ok sub {
 209     $record->dict_with_maybe({name=>'frith', age=>23});
 210 } => 'Set dict attribute without error';
 211
 212 is $record->dict_with_maybe->{name}, 'frith'
 213  => 'correct set the dict attribute name';
 214
 215 is $record->dict_with_maybe->{age}, 23
 216  => 'correct set the dict attribute age';
 217
 218 throws_ok sub {
 219     $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
 220 }, qr/Validation failed for 'Str'/
 221  => 'Got Expected Error for bad value in dict';
 222
 223 throws_ok sub {
 224     $record->dict_with_maybe({age=>30});
 225 }, qr/Validation failed for 'Str'/
 226  => 'Got Expected Error for missing named parameter';
 227
 228 lives_ok sub {
 229     $record->dict_with_maybe({name=>'usal'});
 230 } => 'Set dict attribute without error, skipping optional';
 231
 232 ## Test dict_with_tuple
 233
 234 lives_ok sub {
 235     $record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
 236 } => 'Set tuple attribute without error';
 237
 238 throws_ok sub {
 239     $record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
 240 }, qr/Validation failed for 'Int'/
 241  => 'Threw error on bad constraint';
 242
 243 ## Test optional_tuple
 244
 245 lives_ok sub {
 246     $record->optional_tuple([1,2,3]);
 247 } => 'Set tuple attribute with optional bits';
 248
 249 is_deeply $record->optional_tuple, [1,2,3]
 250  => 'correct values set';
 251
 252 lives_ok sub {
 253     $record->optional_tuple([4,5]);
 254 } => 'Set tuple attribute withOUT optional bits';
 255
 256 is_deeply $record->optional_tuple, [4,5]
 257  => 'correct values set again';
 258
 259 throws_ok sub {
 260     $record->optional_tuple([1,2,'bad']);
 261 }, qr/Validation failed for 'Int'/
 262  => 'Properly failed for bad value in optional bit';
 263
 264 # Test optional_dict
 265
 266 lives_ok sub {
 267     $record->optional_dict({key1=>1,key2=>2});
 268 } => 'Set tuple attribute with optional bits';
 269
 270 is_deeply $record->optional_dict, {key1=>1,key2=>2}
 271  => 'correct values set';
 272
 273 lives_ok sub {
 274     $record->optional_dict({key1=>3});
 275 } => 'Set tuple attribute withOUT optional bits';
 276
 277 is_deeply $record->optional_dict, {key1=>3}
 278  => 'correct values set again';
 279
 280 throws_ok sub {
 281     $record->optional_dict({key1=>1,key2=>'bad'});
 282 }, qr/Validation failed for 'Int'/
 283  => 'Properly failed for bad value in optional bit';
 284