t/constraints.t

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