t/02-depending.t

   1 use Test::More tests=>29; {
   2
   3     use strict;
   4     use warnings;
   5
   6     use MooseX::Types::Dependent qw(Depending);
   7         use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
   8         use MooseX::Types -declare => [qw(
   9         IntGreaterThanInt
  10         UniqueInt
  11                 UniqueInt2
  12     )];
  13
  14         ## sugar for alternative syntax: depending {} TC,TC
  15         sub depending(&@) {
  16                 my ($coderef, $dependent_tc, $constraining_tc, @args) = @_;
  17                 if(@args) {
  18                         return (Depending[$dependent_tc,$coderef,$constraining_tc],@args);
  19                 } else {
  20                         return Depending[$dependent_tc,$coderef,$constraining_tc];
  21                 }
  22         }
  23
  24     ## The dependent value must exceed the constraining value
  25     subtype IntGreaterThanInt,
  26       as Depending[
  27         Int,
  28         sub {
  29             my ($dependent_val, $constraining_val) = @_;
  30             return ($dependent_val > $constraining_val) ? 1:undef;
  31         },
  32         Int,
  33       ];
  34
  35         isa_ok IntGreaterThanInt, 'MooseX::Meta::TypeConstraint::Dependent';
  36         ok !IntGreaterThanInt->check(['a',10]), "Fails, 'a' is not an Int.";
  37         ok !IntGreaterThanInt->check([5,'b']), "Fails, 'b' is not an Int either.";
  38         ok !IntGreaterThanInt->check({4,1}), "Fails, since this isn't an arrayref";
  39         ok !IntGreaterThanInt->check([5,10]), "Fails, 5 is less than 10";
  40         ok IntGreaterThanInt->check([11,6]), "Success, 11 is greater than 6.";
  41         ok IntGreaterThanInt->check([12,1]), "Success, 12 is greater than1.";
  42         ok IntGreaterThanInt->check([0,-10]), "Success, 0 is greater than -10.";
  43
  44     ## The dependent value cannot exist in the constraining arrayref.  Also, it
  45         ## (the dependent type) must exceed 2.
  46     subtype UniqueInt,
  47       as Depending[
  48         Int,
  49         sub {
  50             my ($dependent_int, $constraining_arrayref) = @_;
  51             (grep { $_ == $dependent_int} @$constraining_arrayref) ? undef:1
  52         },
  53         ArrayRef[Int],
  54       ],
  55           where {
  56                 my ($dependent_val, $constraining_value) = @$_;
  57                 return $dependent_val > 2 ? 1:undef;
  58           };
  59           #message {"Custom Error: $_"};
  60
  61     isa_ok UniqueInt, 'MooseX::Meta::TypeConstraint::Dependent';
  62     ok !UniqueInt->check(['a',[1,2,3]]), '"a" not an Int';
  63     ok !UniqueInt->check([1,['b','c']]), '"b","c" not an arrayref';
  64     ok !UniqueInt->check([1,[1,2,3]]), 'not unique in set';
  65     ok !UniqueInt->check([10,[1,10,15]]), 'not unique in set';
  66     ok !UniqueInt->check([2,[3..6]]), 'FAIL dependent is too small';
  67     ok UniqueInt->check([3,[100..110]]), 'PASS unique in set';
  68     ok UniqueInt->check([4,[100..110]]), 'PASS unique in set';
  69
  70         ## Basically as above, with sugar.
  71     subtype UniqueInt2,
  72           as depending {
  73             my ($dependent_int, $constraining_arrayref) = @_;
  74             (grep { $_ == $dependent_int} @$constraining_arrayref) ? undef:1
  75           } Int, ArrayRef[Int],
  76           where {
  77                 my ($dependent_val, $constraining_value) = @$_;
  78                 return $dependent_val > 2 ? 1:undef;
  79           };
  80
  81     isa_ok UniqueInt2, 'MooseX::Meta::TypeConstraint::Dependent';
  82     ok !UniqueInt2->check(['a',[1,2,3]]), '"a" not an Int';
  83     ok !UniqueInt2->check([1,['b','c']]), '"b","c" not an arrayref';
  84     ok !UniqueInt2->check([1,[1,2,3]]), 'not unique in set';
  85     ok !UniqueInt2->check([10,[1,10,15]]), 'not unique in set';
  86     ok !UniqueInt2->check([2,[3..6]]), 'FAIL dependent is too small';
  87     ok UniqueInt2->check([3,[100..110]]), 'PASS unique in set';
  88     ok UniqueInt2->check([4,[100..110]]), 'PASS unique in set';
  89
  90         ## Basic error messages.  TODO should be it's own test
  91         like UniqueInt->validate(['a',[1,2,3]]), qr/failed for 'Int' failed with value a/,
  92           "a is not an Int";
  93
  94         like UniqueInt->validate([1,['b','c']]), qr/failed for 'ArrayRef\[Int\]'/,
  95           "ArrayRef doesn't contain Ints";
  96
  97         like UniqueInt->validate([1,[1,2,3]]), qr/failed with value \[ 1, \[ 1, 2, 3 \] \]/,
  98           "Is not unique in the constraint";
  99
 100     like UniqueInt->validate([10,[1,10,15]]), qr/failed with value \[ 10, \[ 1, 10, 15 \] \]/,
 101           "Expected Error message for [10,[1,10,15]]";
 102
 103     like UniqueInt->validate([2,[3..6]]), qr/failed with value \[ 2, \[ 3, 4, 5, 6 \] \]/,
 104           "Expected Error message for [2,[3..6]]";
 105 }