t/03-dict.t

   1 BEGIN {
   2     use strict;
   3     use warnings;
   4     use Test::More tests=>17;
   5     use Test::Fatal;
   6 }
   7
   8 {
   9     package Test::MooseX::Meta::TypeConstraint::Structured::Dict;
  10
  11     use Moose;
  12     use MooseX::Types::Structured qw(Dict Tuple);
  13     use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
  14     use MooseX::Types -declare => [qw(MyString)];
  15
  16     subtype MyString,
  17      as Str,
  18      where { $_=~m/abc/};
  19
  20     has 'dict' => (is=>'rw', isa=>Dict[name=>Str, age=>Int]);
  21     has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>Str, age=>Maybe[Int]]);
  22     has 'dict_with_tuple_with_union' => (is=>'rw', isa=>Dict[key1=>Str|Object, key2=>Tuple[Int,Str|Object]] );
  23 }
  24
  25 ## Instantiate a new test object
  26
  27 ok my $record = Test::MooseX::Meta::TypeConstraint::Structured::Dict->new
  28  => 'Instantiated new Record test class.';
  29
  30 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Dict'
  31  => 'Created correct object type.';
  32
  33 # Test dict Dict[name=>Str, age=>Int]
  34
  35 is( exception {
  36     $record->dict({name=>'frith', age=>23});
  37 } => undef, 'Set dict attribute without error');
  38
  39 is $record->dict->{name}, 'frith'
  40  => 'correct set the dict attribute name';
  41
  42 is $record->dict->{age}, 23
  43  => 'correct set the dict attribute age';
  44
  45 like( exception {
  46     $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
  47 }, qr/Attribute \(dict\) does not pass the type constraint/
  48  => 'Got Expected Error for bad value in dict');
  49
  50 ## Test dict_with_maybe
  51
  52 is( exception {
  53     $record->dict_with_maybe({name=>'frith', age=>23});
  54 } => undef, 'Set dict attribute without error');
  55
  56 is $record->dict_with_maybe->{name}, 'frith'
  57  => 'correct set the dict attribute name';
  58
  59 is $record->dict_with_maybe->{age}, 23
  60  => 'correct set the dict attribute age';
  61
  62 like( exception {
  63     $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
  64 }, qr/Attribute \(dict_with_maybe\) does not pass the type constraint/
  65  => 'Got Expected Error for bad value in dict');
  66
  67 like( exception {
  68     $record->dict_with_maybe({age=>30});
  69 }, qr/Attribute \(dict_with_maybe\) does not pass the type constraint/
  70  => 'Got Expected Error for missing named parameter');
  71
  72 is( exception {
  73     $record->dict_with_maybe({name=>'usal', age=>undef});
  74 } => undef, 'Set dict attribute without error, skipping maybe');
  75
  76 ## Test dict_with_tuple_with_union: Dict[key1=>'Str|Object', key2=>Tuple['Int','Str|Object']]
  77
  78 is( exception {
  79     $record->dict_with_tuple_with_union({key1=>'Hello', key2=>[1,'World']});
  80 } => undef, 'Set tuple attribute without error');
  81
  82 like( exception {
  83     $record->dict_with_tuple_with_union({key1=>'Hello', key2=>['World',2]});
  84 }, qr/Attribute \(dict_with_tuple_with_union\) does not pass the type constraint/
  85  => 'Threw error on bad constraint');
  86
  87 is( exception {
  88     $record->dict_with_tuple_with_union({key1=>$record, key2=>[1,'World']});
  89 } => undef, 'Set tuple attribute without error');
  90
  91 is( exception {
  92     $record->dict_with_tuple_with_union({key1=>'Hello', key2=>[1,$record]});
  93 } => undef, 'Set tuple attribute without error');
  94
  95 like( exception {
  96     $record->dict_with_tuple_with_union({key1=>1, key2=>['World',2]});
  97 }, qr/Attribute \(dict_with_tuple_with_union\) does not pass the type constraint/
  98  => 'Threw error on bad constraint');