t/constraints.t

   1 BEGIN {
   2         use strict;
   3         use warnings;
   4         use Test::More tests=>35;
   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($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
  75 ## Instantiate a new test object
  76
  77 ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
  78  => 'Instantiated new Record test class.';
  79
  80 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
  81  => 'Created correct object type.';
  82
  83 ## Test Tuple type constraint
  84
  85 lives_ok sub {
  86     $record->tuple([1,'hello', 'test.abc.test']);
  87 } => 'Set tuple attribute without error';
  88
  89 is $record->tuple->[0], 1
  90  => 'correct set the tuple attribute index 0';
  91
  92 is $record->tuple->[1], 'hello'
  93  => 'correct set the tuple attribute index 1';
  94
  95 is $record->tuple->[2], 'test.abc.test'
  96  => 'correct set the tuple attribute index 2';
  97
  98 throws_ok sub {
  99     $record->tuple([1,'hello', 'test.xxx.test']);
 100 }, qr/Validation failed for 'MyString'/
 101  => 'Properly failed for bad value in custom type constraint';
 102
 103 throws_ok sub {
 104     $record->tuple(['asdasd',2, 'test.abc.test']);
 105 }, qr/Validation failed for 'Int'/
 106  => 'Got Expected Error for violating constraints';
 107
 108 ## Test the Dictionary type constraint
 109
 110 lives_ok sub {
 111     $record->dict({name=>'frith', age=>23});
 112 } => 'Set dict attribute without error';
 113
 114 is $record->dict->{name}, 'frith'
 115  => 'correct set the dict attribute name';
 116
 117 is $record->dict->{age}, 23
 118  => 'correct set the dict attribute age';
 119
 120 throws_ok sub {
 121     $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
 122 }, qr/Validation failed for 'Str'/
 123  => 'Got Expected Error for bad value in dict';
 124
 125 ## Test tuple_with_maybe
 126
 127 lives_ok sub {
 128     $record->tuple_with_maybe([1,'hello', 1]);
 129 } => 'Set tuple attribute without error';
 130
 131 throws_ok sub {
 132     $record->tuple_with_maybe([1,'hello', 'a']);
 133 }, qr/Validation failed for 'Maybe\[Int\]'/
 134  => 'Properly failed for bad value parameterized constraint';
 135
 136 lives_ok sub {
 137     $record->tuple_with_maybe([1,'hello']);
 138 } => 'Set tuple attribute without error skipping optional parameter';
 139
 140 ## Test Tuple with parameterized type
 141
 142 lives_ok sub {
 143     $record->tuple_with_param([1,'hello', [1,2,3]]);
 144 } => 'Set tuple attribute without error';
 145
 146 throws_ok sub {
 147     $record->tuple_with_param([1,'hello', [qw/a b c/]]);
 148 }, qr/Validation failed for 'ArrayRef\[Int\]'/
 149  => 'Properly failed for bad value parameterized constraint';
 150
 151 ## Test dict_with_maybe
 152
 153 lives_ok sub {
 154     $record->dict_with_maybe({name=>'frith', age=>23});
 155 } => 'Set dict attribute without error';
 156
 157 is $record->dict_with_maybe->{name}, 'frith'
 158  => 'correct set the dict attribute name';
 159
 160 is $record->dict_with_maybe->{age}, 23
 161  => 'correct set the dict attribute age';
 162
 163 throws_ok sub {
 164     $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
 165 }, qr/Validation failed for 'Str'/
 166  => 'Got Expected Error for bad value in dict';
 167
 168 throws_ok sub {
 169     $record->dict_with_maybe({age=>30});
 170 }, qr/Validation failed for 'Str'/
 171  => 'Got Expected Error for missing named parameter';
 172
 173 lives_ok sub {
 174     $record->dict_with_maybe({name=>'usal'});
 175 } => 'Set dict attribute without error, skipping optional';
 176
 177 ## Test dict_with_tuple
 178
 179 lives_ok sub {
 180     $record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
 181 } => 'Set tuple attribute without error';
 182
 183 throws_ok sub {
 184     $record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
 185 }, qr/Validation failed for 'Int'/
 186  => 'Threw error on bad constraint';
 187
 188 ## Test optional_tuple
 189
 190 lives_ok sub {
 191     $record->optional_tuple([1,2,3]);
 192 } => 'Set tuple attribute with optional bits';
 193
 194 is_deeply $record->optional_tuple, [1,2,3]
 195  => 'correct values set';
 196
 197 lives_ok sub {
 198     $record->optional_tuple([4,5]);
 199 } => 'Set tuple attribute withOUT optional bits';
 200
 201 is_deeply $record->optional_tuple, [4,5]
 202  => 'correct values set again';
 203
 204 throws_ok sub {
 205     $record->optional_tuple([1,2,'bad']);
 206 }, qr/Validation failed for 'Int'/
 207  => 'Properly failed for bad value in optional bit';
 208
 209 # Test optional_dict
 210
 211 lives_ok sub {
 212     $record->optional_dict({key1=>1,key2=>2});
 213 } => 'Set tuple attribute with optional bits';
 214
 215 is_deeply $record->optional_dict, {key1=>1,key2=>2}
 216  => 'correct values set';
 217
 218 lives_ok sub {
 219     $record->optional_dict({key1=>3});
 220 } => 'Set tuple attribute withOUT optional bits';
 221
 222 is_deeply $record->optional_dict, {key1=>3}
 223  => 'correct values set again';
 224
 225 throws_ok sub {
 226     $record->optional_dict({key1=>1,key2=>'bad'});
 227 }, qr/Validation failed for 'Int'/
 228  => 'Properly failed for bad value in optional bit';
 229
 230
 231