t/02-types-parameterizable-extended.t

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