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     ##has 'sugered' => ();
 100 }
 101
 102 ## Instantiate a new test object
 103
 104 ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
 105  => 'Instantiated new Record test class.';
 106
 107 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
 108  => 'Created correct object type.';
 109
 110 ## Test crazy
 111
 112 lives_ok sub {
 113     $record->crazy([1,'hello.abc.world', {name=>'John', age=>39}]);
 114 } => 'Set crazy attribute with no optionals used';
 115
 116 is_deeply $record->crazy, [1, 'hello.abc.world', {name=>'John', age=>39}]
 117  => 'correct values for crazy attributes no optionals';
 118
 119 lives_ok sub {
 120     $record->crazy([1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]);
 121 } => 'Set crazy attribute with all optionals used';
 122
 123 is_deeply $record->crazy, [1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]
 124  => 'correct values for crazy attributes all optionals';
 125
 126 lives_ok sub {
 127     $record->crazy([1,'hello.abc.world', {name=>'John', age=>39},10, [1,2]]);
 128 } => 'Set crazy attribute with some optionals used';
 129
 130 throws_ok sub {
 131     $record->crazy([1,'hello', 'test.xxx.test']);
 132 }, qr/Validation failed for 'MyString'/
 133  => 'Properly failed for bad value in crazy attribute 01';
 134
 135 throws_ok sub {
 136     $record->crazy([1,'hello.abc.world', {notname=>'John', notage=>39}]);
 137 }, qr/Validation failed for 'Str'/
 138  => 'Properly failed for bad value in crazy attribute 02';
 139
 140 ## Test Tuple type constraint
 141
 142 lives_ok sub {
 143     $record->tuple([1,'hello', 'test.abc.test']);
 144 } => 'Set tuple attribute without error';
 145
 146 is $record->tuple->[0], 1
 147  => 'correct set the tuple attribute index 0';
 148
 149 is $record->tuple->[1], 'hello'
 150  => 'correct set the tuple attribute index 1';
 151
 152 is $record->tuple->[2], 'test.abc.test'
 153  => 'correct set the tuple attribute index 2';
 154
 155 throws_ok sub {
 156     $record->tuple([1,'hello', 'test.xxx.test']);
 157 }, qr/Validation failed for 'MyString'/
 158  => 'Properly failed for bad value in custom type constraint';
 159
 160 throws_ok sub {
 161     $record->tuple(['asdasd',2, 'test.abc.test']);
 162 }, qr/Validation failed for 'Int'/
 163  => 'Got Expected Error for violating constraints';
 164
 165 ## Test the Dictionary type constraint
 166
 167 lives_ok sub {
 168     $record->dict({name=>'frith', age=>23});
 169 } => 'Set dict attribute without error';
 170
 171 is $record->dict->{name}, 'frith'
 172  => 'correct set the dict attribute name';
 173
 174 is $record->dict->{age}, 23
 175  => 'correct set the dict attribute age';
 176
 177 throws_ok sub {
 178     $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
 179 }, qr/Validation failed for 'Str'/
 180  => 'Got Expected Error for bad value in dict';
 181
 182 ## Test tuple_with_maybe
 183
 184 lives_ok sub {
 185     $record->tuple_with_maybe([1,'hello', 1]);
 186 } => 'Set tuple attribute without error';
 187
 188 throws_ok sub {
 189     $record->tuple_with_maybe([1,'hello', 'a']);
 190 }, qr/Validation failed for 'Maybe\[Int\]'/
 191  => 'Properly failed for bad value parameterized constraint';
 192
 193 lives_ok sub {
 194     $record->tuple_with_maybe([1,'hello']);
 195 } => 'Set tuple attribute without error skipping optional parameter';
 196
 197 ## Test Tuple with parameterized type
 198
 199 lives_ok sub {
 200     $record->tuple_with_param([1,'hello', [1,2,3]]);
 201 } => 'Set tuple attribute without error';
 202
 203 throws_ok sub {
 204     $record->tuple_with_param([1,'hello', [qw/a b c/]]);
 205 }, qr/Validation failed for 'ArrayRef\[Int\]'/
 206  => 'Properly failed for bad value parameterized constraint';
 207
 208 ## Test dict_with_maybe
 209
 210 lives_ok sub {
 211     $record->dict_with_maybe({name=>'frith', age=>23});
 212 } => 'Set dict attribute without error';
 213
 214 is $record->dict_with_maybe->{name}, 'frith'
 215  => 'correct set the dict attribute name';
 216
 217 is $record->dict_with_maybe->{age}, 23
 218  => 'correct set the dict attribute age';
 219
 220 throws_ok sub {
 221     $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
 222 }, qr/Validation failed for 'Str'/
 223  => 'Got Expected Error for bad value in dict';
 224
 225 throws_ok sub {
 226     $record->dict_with_maybe({age=>30});
 227 }, qr/Validation failed for 'Str'/
 228  => 'Got Expected Error for missing named parameter';
 229
 230 lives_ok sub {
 231     $record->dict_with_maybe({name=>'usal'});
 232 } => 'Set dict attribute without error, skipping optional';
 233
 234 ## Test dict_with_tuple
 235
 236 lives_ok sub {
 237     $record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
 238 } => 'Set tuple attribute without error';
 239
 240 throws_ok sub {
 241     $record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
 242 }, qr/Validation failed for 'Int'/
 243  => 'Threw error on bad constraint';
 244
 245 ## Test optional_tuple
 246
 247 lives_ok sub {
 248     $record->optional_tuple([1,2,3]);
 249 } => 'Set tuple attribute with optional bits';
 250
 251 is_deeply $record->optional_tuple, [1,2,3]
 252  => 'correct values set';
 253
 254 lives_ok sub {
 255     $record->optional_tuple([4,5]);
 256 } => 'Set tuple attribute withOUT optional bits';
 257
 258 is_deeply $record->optional_tuple, [4,5]
 259  => 'correct values set again';
 260
 261 throws_ok sub {
 262     $record->optional_tuple([1,2,'bad']);
 263 }, qr/Validation failed for 'Int'/
 264  => 'Properly failed for bad value in optional bit';
 265
 266 # Test optional_dict
 267
 268 lives_ok sub {
 269     $record->optional_dict({key1=>1,key2=>2});
 270 } => 'Set tuple attribute with optional bits';
 271
 272 is_deeply $record->optional_dict, {key1=>1,key2=>2}
 273  => 'correct values set';
 274
 275 lives_ok sub {
 276     $record->optional_dict({key1=>3});
 277 } => 'Set tuple attribute withOUT optional bits';
 278
 279 is_deeply $record->optional_dict, {key1=>3}
 280  => 'correct values set again';
 281
 282 throws_ok sub {
 283     $record->optional_dict({key1=>1,key2=>'bad'});
 284 }, qr/Validation failed for 'Int'/
 285  => 'Properly failed for bad value in optional bit';
 286
 287
 288