t/constraints.t

   1 BEGIN {
   2         use strict;
   3         use warnings;
   4         use Test::More tests=>23;
   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                                 Moose::Util::TypeConstraints::find_or_parse_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                                 $_ => Moose::Util::TypeConstraints::find_or_parse_type_constraint($args{$_})
  39                         } keys %args},
  40         );
  41     }
  42
  43     has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
  44     has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
  45     has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']);
  46         has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
  47         has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
  48 }
  49
  50 ## Instantiate a new test object
  51
  52 ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
  53  => 'Instantiated new Record test class.';
  54
  55 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
  56  => 'Created correct object type.';
  57
  58 ## Test Tuple type constraint
  59
  60 lives_ok sub {
  61     $record->tuple([1,'hello', 'test.abc.test']);
  62 } => 'Set tuple attribute without error';
  63
  64 is $record->tuple->[0], 1
  65  => 'correct set the tuple attribute index 0';
  66
  67 is $record->tuple->[1], 'hello'
  68  => 'correct set the tuple attribute index 1';
  69
  70 is $record->tuple->[2], 'test.abc.test'
  71  => 'correct set the tuple attribute index 2';
  72
  73 throws_ok sub {
  74     $record->tuple([1,'hello', 'test.xxx.test']);
  75 }, qr/Validation failed for 'MyString'/
  76  => 'Properly failed for bad value in custom type constraint';
  77
  78 throws_ok sub {
  79     $record->tuple(['asdasd',2, 'test.abc.test']);
  80 }, qr/Validation failed for 'Int'/
  81  => 'Got Expected Error for violating constraints';
  82
  83 ## Test the Dictionary type constraint
  84
  85 lives_ok sub {
  86     $record->dict({name=>'frith', age=>23});
  87 } => 'Set dict attribute without error';
  88
  89 is $record->dict->{name}, 'frith'
  90  => 'correct set the dict attribute name';
  91
  92 is $record->dict->{age}, 23
  93  => 'correct set the dict attribute age';
  94
  95 throws_ok sub {
  96     $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
  97 }, qr/Validation failed for 'Str'/
  98  => 'Got Expected Error for bad value in dict';
  99
 100 ## Test tuple_with_maybe
 101
 102 lives_ok sub {
 103     $record->tuple_with_maybe([1,'hello', 1]);
 104 } => 'Set tuple attribute without error';
 105
 106 throws_ok sub {
 107     $record->tuple_with_maybe([1,'hello', 'a']);
 108 }, qr/Validation failed for 'Maybe\[Int\]'/
 109  => 'Properly failed for bad value parameterized constraint';
 110
 111 lives_ok sub {
 112     $record->tuple_with_maybe([1,'hello']);
 113 } => 'Set tuple attribute without error skipping optional parameter';
 114
 115 ## Test Tuple with parameterized type
 116
 117 lives_ok sub {
 118     $record->tuple_with_param([1,'hello', [1,2,3]]);
 119 } => 'Set tuple attribute without error';
 120
 121 throws_ok sub {
 122     $record->tuple_with_param([1,'hello', [qw/a b c/]]);
 123 }, qr/Validation failed for 'ArrayRef\[Int\]'/
 124  => 'Properly failed for bad value parameterized constraint';
 125
 126 ## Test dict_with_maybe
 127
 128 lives_ok sub {
 129     $record->dict_with_maybe({name=>'frith', age=>23});
 130 } => 'Set dict attribute without error';
 131
 132 is $record->dict_with_maybe->{name}, 'frith'
 133  => 'correct set the dict attribute name';
 134
 135 is $record->dict_with_maybe->{age}, 23
 136  => 'correct set the dict attribute age';
 137
 138 throws_ok sub {
 139     $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
 140 }, qr/Validation failed for 'Str'/
 141  => 'Got Expected Error for bad value in dict';
 142
 143 throws_ok sub {
 144     $record->dict_with_maybe({age=>30});
 145 }, qr/Validation failed for 'Str'/
 146  => 'Got Expected Error for missing named parameter';
 147
 148 lives_ok sub {
 149     $record->dict_with_maybe({name=>'usal'});
 150 } => 'Set dict attribute without error, skipping optional';
 151