t/02-types-parameterizable-extended.t

   1
   2 use Test::More; {
   3
   4     use strict;
   5     use warnings;
   6
   7     eval "use MooseX::Types::Structured"; if($@) {
   8         plan skip_all => "MooseX::Types:Structured Required for advanced Tests";
   9     } else {
  10         eval "use Set::Scalar"; if($@) {
  11             plan skip_all => "Set::Scalar Required for advanced Tests";
  12         } else {
  13             plan tests => 37;
  14         }
  15     }
  16
  17     use MooseX::Types::Structured qw(Tuple Dict slurpy);
  18     use MooseX::Types::Parameterizable qw(Parameterizable);
  19     use MooseX::Types::Moose qw(Int Str);
  20     use Moose::Util::TypeConstraints;
  21
  22     use MooseX::Types -declare=>[qw(
  23         Set UniqueInt UniqueInSet Range RangedInt PositiveRangedInt1
  24         PositiveRangedInt2 PositiveInt PositiveRange NameAge NameBetween18and35Age
  25     )];
  26
  27     ok class_type("Set::Scalar"), 'Created Set::Scalar class_type';
  28     ok subtype( Set, as "Set::Scalar"), 'Created Set subtype';
  29
  30     ok subtype( UniqueInt,
  31         as Parameterizable[Int, Set],
  32         where {
  33             my ($int, $set) = @_;
  34             return !$set->has($int);
  35         }), 'Created UniqueInt Parameterizable Type';
  36
  37     ok( (my $set_obj = Set::Scalar->new(1,2,3,4,5)), 'Create Set Object');
  38
  39     ok !UniqueInt([$set_obj])->check(1), "Not OK, since one isn't unique in $set_obj";
  40     ok !UniqueInt([$set_obj])->check('AAA'), "Not OK, since AAA is not an Int";
  41     ok UniqueInt([$set_obj])->check(100), "OK, since 100 isn't in the set";
  42
  43     ok( (my $unique = UniqueInt[$set_obj]), 'Created Anonymous typeconstraint');
  44     ok $unique->check(10), "OK, 10 is unique";
  45     ok !$unique->check(2), "Not OK, '2' is already in the set";
  46
  47     ok( subtype(UniqueInSet, as UniqueInt[$set_obj]), 'Created Subtype');
  48     ok UniqueInSet->check(99), '99 is unique';
  49     ok !UniqueInSet->check(3), 'Not OK, 3 is already in the set';
  50
  51     CHECKHARDEXCEPTION: {
  52         eval { UniqueInt->check(1000) };
  53         like $@,
  54           qr/Validation failed for 'main::Set' with value undef/,
  55           'Got Expected Error';
  56
  57         eval { UniqueInt->validate(1000) };
  58         like $@,
  59           qr/Validation failed for 'main::Set' with value undef/,
  60           'Got Expected Error';
  61     }
  62
  63     subtype Range,
  64         as Dict[max=>Int, min=>Int],
  65         where {
  66             my ($range) = @_;
  67             return $range->{max} > $range->{min};
  68         };
  69
  70     subtype RangedInt,
  71         as Parameterizable[Int, Range],
  72         where {
  73             my ($value, $range) = @_;
  74             return ($value >= $range->{min} &&
  75              $value <= $range->{max});
  76         };
  77
  78     ok RangedInt([{min=>10,max=>100}])->check(50), '50 in the range';
  79     ok !RangedInt([{min=>50, max=>75}])->check(99),'99 exceeds max';
  80     ok !RangedInt([{min=>50, max=>75}])->check('aa'), '"aa" not even an Int';
  81
  82     CHECKRANGEDINT: {
  83         eval {
  84             RangedInt([{min=>99, max=>10}])->check(10); ## Not OK, not a valid Range!
  85         };
  86
  87         like $@,
  88           qr/Validation failed for 'main::Range'/,
  89           'Got Expected Error';
  90     }
  91
  92     ok RangedInt([min=>10,max=>100])->check(50), '50 in the range';
  93     ok !RangedInt([min=>50, max=>75])->check(99),'99 exceeds max';
  94     ok !RangedInt([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
  95
  96     CHECKRANGEDINT2: {
  97         eval {
  98             RangedInt([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
  99         };
 100
 101         like $@,
 102           qr/Validation failed for 'main::Range'/,
 103           'Got Expected Error';
 104     }
 105
 106     subtype PositiveRangedInt1,
 107         as RangedInt,
 108         where {
 109             shift >= 0;
 110         };
 111
 112     ok PositiveRangedInt1([min=>10,max=>100])->check(50), '50 in the range';
 113     ok !PositiveRangedInt1([min=>50, max=>75])->check(99),'99 exceeds max';
 114     ok !PositiveRangedInt1([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
 115
 116     CHECKRANGEDINT2: {
 117         eval {
 118             PositiveRangedInt1([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
 119         };
 120
 121         like $@,
 122           qr/Validation failed for 'main::Range'/,
 123           'Got Expected Error';
 124     }
 125
 126     ok !PositiveRangedInt1([min=>-100,max=>100])->check(-10), '-10 is not positive';
 127
 128     subtype PositiveInt,
 129         as Int,
 130         where {
 131             my ($value, $range) = @_;
 132             return $value >= 0;
 133         };
 134
 135     ## subtype Range to re-parameterize Range with subtypes
 136     subtype PositiveRange,
 137         as Range[max=>PositiveInt, min=>PositiveInt];
 138
 139     ## create subtype via reparameterizing
 140     subtype PositiveRangedInt2,
 141         as RangedInt[PositiveRange];
 142
 143     ok PositiveRangedInt2([min=>10,max=>100])->check(50), '50 in the range';
 144     ok !PositiveRangedInt2([min=>50, max=>75])->check(99),'99 exceeds max';
 145     ok !PositiveRangedInt2([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
 146
 147     CHECKRANGEDINT2: {
 148         eval {
 149             PositiveRangedInt2([min=>-100,max=>100])->check(-10); ## Not OK, not a valid Range!
 150         };
 151
 152         like $@,
 153           qr/Validation failed for 'main::PositiveRange'/,
 154           'Got Expected Error';
 155     }
 156
 157     subtype NameAge,
 158         as Tuple[Str, Int];
 159
 160     ok NameAge->check(['John',28]), 'Good NameAge';
 161     ok !NameAge->check(['John','Napiorkowski']), 'Bad NameAge';
 162
 163     subtype NameBetween18and35Age,
 164         as NameAge[
 165             Str,
 166             PositiveRangedInt2[min=>18,max=>35],
 167         ];
 168
 169     ok NameBetween18and35Age->check(['John',28]), 'Good NameBetween18and35Age';
 170     ok !NameBetween18and35Age->check(['John','Napiorkowski']), 'Bad NameBetween18and35Age';
 171     ok !NameBetween18and35Age->check(['John',99]), 'Bad NameBetween18and35Age';
 172 }