t/05-advanced.t

   1 BEGIN {
   2     use strict;
   3     use warnings;
   4     use Test::More tests=>16;
   5     use Test::Exception;
   6 }
   7
   8 {
   9     package Test::MooseX::Meta::TypeConstraint::Structured::Advanced;
  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(
  15         EqualLength MoreThanFive MoreLengthPlease PersonalInfo MorePersonalInfo
  16         MinFiveChars
  17     )];
  18
  19     subtype MoreThanFive,
  20      as Int,
  21      where { $_ > 5};
  22
  23     ## Tuple contains two equal length Arrays
  24     subtype EqualLength,
  25      as Tuple[ArrayRef[MoreThanFive],ArrayRef[MoreThanFive]],
  26      where { $#{$_->[0]} == $#{$_->[1]} };
  27
  28     ## subclass the complex tuple
  29     subtype MoreLengthPlease,
  30      as EqualLength,
  31      where { $#{$_->[0]} >= 4};
  32
  33     ## Complexe Dict
  34     subtype PersonalInfo,
  35      as Dict[name=>Str, stats=>MoreLengthPlease|Object];
  36
  37     ## Minimum 5 char string
  38     subtype MinFiveChars,
  39      as Str,
  40      where { length($_) > 5};
  41
  42     ## Dict key overloading
  43     subtype MorePersonalInfo,
  44      as PersonalInfo[name=>MinFiveChars, stats=>MoreLengthPlease|Object];
  45
  46     has 'EqualLengthAttr' => (is=>'rw', isa=>EqualLength);
  47     has 'MoreLengthPleaseAttr' => (is=>'rw', isa=>MoreLengthPlease);
  48     has 'PersonalInfoAttr' => (is=>'rw', isa=>PersonalInfo);
  49     has 'MorePersonalInfo' => (is=>'rw', isa=>MorePersonalInfo);
  50 }
  51
  52 ## Instantiate a new test object
  53
  54 ok my $obj = Test::MooseX::Meta::TypeConstraint::Structured::Advanced->new
  55  => 'Instantiated new Record test class.';
  56
  57 isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Advanced'
  58  => 'Created correct object type.';
  59
  60 ## Test EqualLengthAttr
  61
  62 lives_ok sub {
  63     $obj->EqualLengthAttr([[6,7,8],[9,10,11]]);
  64 } => 'Set EqualLengthAttr attribute without error';
  65
  66 throws_ok sub {
  67     $obj->EqualLengthAttr([1,'hello', 'test.xxx.test']);
  68 }, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/
  69  => q{EqualLengthAttr correctly fails [1,'hello', 'test.xxx.test']};
  70
  71 throws_ok sub {
  72     $obj->EqualLengthAttr([[6,7],[9,10,11]]);
  73 }, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/
  74  => q{EqualLengthAttr correctly fails [[6,7],[9,10,11]]};
  75
  76 throws_ok sub {
  77     $obj->EqualLengthAttr([[6,7,1],[9,10,11]]);
  78 }, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/
  79  => q{EqualLengthAttr correctly fails [[6,7,1],[9,10,11]]};
  80
  81 ## Test MoreLengthPleaseAttr
  82
  83 lives_ok sub {
  84     $obj->MoreLengthPleaseAttr([[6,7,8,9,10],[11,12,13,14,15]]);
  85 } => 'Set MoreLengthPleaseAttr attribute without error';
  86
  87 throws_ok sub {
  88     $obj->MoreLengthPleaseAttr([[6,7,8,9],[11,12,13,14]]);
  89 }, qr/Attribute \(MoreLengthPleaseAttr\) does not pass the type constraint/
  90  => q{MoreLengthPleaseAttr correctly fails [[6,7,8,9],[11,12,13,14]]};
  91
  92 ## Test PersonalInfoAttr
  93
  94 lives_ok sub {
  95     $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
  96 } => 'Set PersonalInfoAttr attribute without error 1';
  97
  98 lives_ok sub {
  99     $obj->PersonalInfoAttr({name=>'John', stats=>$obj});
 100 } => 'Set PersonalInfoAttr attribute without error 2';
 101
 102 throws_ok sub {
 103     $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]});
 104 }, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/
 105  => q{PersonalInfoAttr correctly fails name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]};
 106
 107 throws_ok sub {
 108     $obj->PersonalInfoAttr({name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
 109 }, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/
 110  => q{PersonalInfoAttr correctly fails name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
 111
 112 ## Test MorePersonalInfo
 113
 114 lives_ok sub {
 115     $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
 116 } => 'Set MorePersonalInfo attribute without error 1';
 117
 118 throws_ok sub {
 119     $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]});
 120 }, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
 121  => q{MorePersonalInfo correctly fails name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]};
 122
 123 throws_ok sub {
 124     $obj->MorePersonalInfo({name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
 125 }, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
 126  => q{MorePersonalInfo correctly fails name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
 127
 128 throws_ok sub {
 129     $obj->MorePersonalInfo({name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});
 130 }, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/
 131  => q{MorePersonalInfo correctly fails name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]};
 132
 133