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::Parameterizable::Types 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' failed with value undef/,
  55                   'Got Expected Error';
  56
  57                 eval { UniqueInt->validate(1000) };
  58                 like $@,
  59                   qr/Validation failed for 'main::Set' failed 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 }