t/constraints.t

   1 BEGIN {
   2         use strict;
   3         use warnings;
   4         use Test::More tests=>25;
   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;
  14
  15     subtype 'MyString',
  16      as 'Str',
  17      where { $_=~m/abc/};
  18
  19     sub Tuple {
  20         my @args = @{shift @_};
  21         return MooseX::Meta::TypeConstraint::Structured->new(
  22             name => 'Tuple',
  23             parent => find_type_constraint('ArrayRef'),
  24             package_defined_in => __PACKAGE__,
  25             signature => [map {
  26                                 _normalize_type_constraint($_);
  27                         } @args],
  28         );
  29     }
  30
  31     sub Dict {
  32         my %args = @{shift @_};
  33         return MooseX::Meta::TypeConstraint::Structured->new(
  34             name => 'Dict',
  35             parent => find_type_constraint('HashRef'),
  36             package_defined_in => __PACKAGE__,
  37             signature => {map {
  38                                 $_ => _normalize_type_constraint($args{$_});
  39                         } keys %args},
  40         );
  41     }
  42
  43         sub _normalize_type_constraint {
  44                 my $tc = shift @_;
  45                 if($tc && blessed $tc && $tc->isa('Moose::Meta::TypeConstraint')) {
  46                         return $tc;
  47                 } elsif($tc) {
  48                         return Moose::Util::TypeConstraints::find_or_parse_type_constraint($tc);
  49                 }
  50         }
  51
  52     has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
  53     has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
  54     has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']);
  55         has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
  56         has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
  57         has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
  58 }
  59
  60 ## Instantiate a new test object
  61
  62 ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
  63  => 'Instantiated new Record test class.';
  64
  65 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
  66  => 'Created correct object type.';
  67
  68 ## Test Tuple type constraint
  69
  70 lives_ok sub {
  71     $record->tuple([1,'hello', 'test.abc.test']);
  72 } => 'Set tuple attribute without error';
  73
  74 is $record->tuple->[0], 1
  75  => 'correct set the tuple attribute index 0';
  76
  77 is $record->tuple->[1], 'hello'
  78  => 'correct set the tuple attribute index 1';
  79
  80 is $record->tuple->[2], 'test.abc.test'
  81  => 'correct set the tuple attribute index 2';
  82
  83 throws_ok sub {
  84     $record->tuple([1,'hello', 'test.xxx.test']);
  85 }, qr/Validation failed for 'MyString'/
  86  => 'Properly failed for bad value in custom type constraint';
  87
  88 throws_ok sub {
  89     $record->tuple(['asdasd',2, 'test.abc.test']);
  90 }, qr/Validation failed for 'Int'/
  91  => 'Got Expected Error for violating constraints';
  92
  93 ## Test the Dictionary type constraint
  94
  95 lives_ok sub {
  96     $record->dict({name=>'frith', age=>23});
  97 } => 'Set dict attribute without error';
  98
  99 is $record->dict->{name}, 'frith'
 100  => 'correct set the dict attribute name';
 101
 102 is $record->dict->{age}, 23
 103  => 'correct set the dict attribute age';
 104
 105 throws_ok sub {
 106     $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
 107 }, qr/Validation failed for 'Str'/
 108  => 'Got Expected Error for bad value in dict';
 109
 110 ## Test tuple_with_maybe
 111
 112 lives_ok sub {
 113     $record->tuple_with_maybe([1,'hello', 1]);
 114 } => 'Set tuple attribute without error';
 115
 116 throws_ok sub {
 117     $record->tuple_with_maybe([1,'hello', 'a']);
 118 }, qr/Validation failed for 'Maybe\[Int\]'/
 119  => 'Properly failed for bad value parameterized constraint';
 120
 121 lives_ok sub {
 122     $record->tuple_with_maybe([1,'hello']);
 123 } => 'Set tuple attribute without error skipping optional parameter';
 124
 125 ## Test Tuple with parameterized type
 126
 127 lives_ok sub {
 128     $record->tuple_with_param([1,'hello', [1,2,3]]);
 129 } => 'Set tuple attribute without error';
 130
 131 throws_ok sub {
 132     $record->tuple_with_param([1,'hello', [qw/a b c/]]);
 133 }, qr/Validation failed for 'ArrayRef\[Int\]'/
 134  => 'Properly failed for bad value parameterized constraint';
 135
 136 ## Test dict_with_maybe
 137
 138 lives_ok sub {
 139     $record->dict_with_maybe({name=>'frith', age=>23});
 140 } => 'Set dict attribute without error';
 141
 142 is $record->dict_with_maybe->{name}, 'frith'
 143  => 'correct set the dict attribute name';
 144
 145 is $record->dict_with_maybe->{age}, 23
 146  => 'correct set the dict attribute age';
 147
 148 throws_ok sub {
 149     $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
 150 }, qr/Validation failed for 'Str'/
 151  => 'Got Expected Error for bad value in dict';
 152
 153 throws_ok sub {
 154     $record->dict_with_maybe({age=>30});
 155 }, qr/Validation failed for 'Str'/
 156  => 'Got Expected Error for missing named parameter';
 157
 158 lives_ok sub {
 159     $record->dict_with_maybe({name=>'usal'});
 160 } => 'Set dict attribute without error, skipping optional';
 161
 162 ## Test dict_with_tuple
 163
 164 lives_ok sub {
 165     $record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
 166 } => 'Set tuple attribute without error';
 167
 168 throws_ok sub {
 169     $record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
 170 }, qr/Validation failed for 'Int'/
 171  => 'Threw error on bad constraint';
 172
 173
 174