t/01-types-parameterizable.t

   1
   2 use Test::More tests=>79; {
   3
   4     use strict;
   5     use warnings;
   6
   7     use MooseX::Types::Parameterizable qw(Parameterizable);
   8     use MooseX::Types::Moose qw(Int Any Maybe);
   9     use Moose::Util::TypeConstraints;
  10
  11     use MooseX::Types -declare=>[qw(SubParameterizable IntLessThan EvenInt
  12         LessThan100GreatThen5andEvenIntNot44 IntNot54
  13         GreatThen5andEvenIntNot54or64)];
  14
  15     ok Parameterizable->check(1),
  16       'Parameterizable is basically an "Any"';
  17
  18     is Parameterizable->validate(1), undef,
  19       'No Error Message';
  20
  21     is Parameterizable->parent, 'Any',
  22       'Parameterizable is an Any';
  23
  24     is Parameterizable->name, 'MooseX::Types::Parameterizable::Parameterizable',
  25       'Parameterizable has expected name';
  26
  27     like Parameterizable->get_message,
  28       qr/Validation failed for 'MooseX::Types::Parameterizable::Parameterizable' with value undef/,
  29       'Got Expected Message';
  30
  31     ok Parameterizable->equals(Parameterizable),
  32       'Parameterizable equal Parameterizable';
  33
  34     ok Parameterizable->is_a_type_of(Parameterizable),
  35       'Parameterizable is_a_type_of Parameterizable';
  36
  37     ok Parameterizable->is_a_type_of('Any'),
  38       'Parameterizable is_a_type_of Any';
  39
  40     ok Parameterizable->is_subtype_of('Any'),
  41       'Parameterizable is_subtype_of Parameterizable';
  42
  43     is Parameterizable->parent_type_constraint, 'Any',
  44       'Correct parent type';
  45
  46     is subtype( SubParameterizable, as Parameterizable ),
  47       'main::SubParameterizable',
  48       'Create a useless subtype';
  49
  50     ok SubParameterizable->check(1),
  51       'SubParameterizable is basically an "Any"';
  52
  53     is SubParameterizable->validate(1), undef,
  54       'validate returned no error message';
  55
  56     is SubParameterizable->parent, 'MooseX::Types::Parameterizable::Parameterizable',
  57       'SubParameterizable is a Parameterizable';
  58
  59     is SubParameterizable->name, 'main::SubParameterizable',
  60       'Parameterizable has expected name';
  61
  62     like SubParameterizable->get_message,
  63       qr/Validation failed for 'main::SubParameterizable' with value undef/,
  64       'Got Expected Message';
  65
  66     ok SubParameterizable->equals(SubParameterizable),
  67       'SubParameterizable equal SubParameterizable';
  68
  69     ok !SubParameterizable->equals(Parameterizable),
  70       'SubParameterizable does not equal Parameterizable';
  71
  72     ok SubParameterizable->is_a_type_of(Parameterizable),
  73       'SubParameterizable is_a_type_of Parameterizable';
  74
  75     ok SubParameterizable->is_a_type_of(Any),
  76       'SubParameterizable is_a_type_of Any';
  77
  78     ok SubParameterizable->is_subtype_of('Any'),
  79       'SubParameterizable is_subtype_of Parameterizable';
  80
  81     ok !SubParameterizable->is_subtype_of(SubParameterizable),
  82       'SubParameterizable is not is_subtype_of SubParameterizable';
  83
  84     ok subtype( EvenInt,
  85         as Int,
  86         where {
  87             my $val = shift @_;
  88             return $val % 2 ? 0:1;
  89         }),
  90       'Created a subtype of Int';
  91
  92     ok !EvenInt->check('aaa'), '"aaa" not an Int';
  93     ok !EvenInt->check(1), '1 is not even';
  94     ok EvenInt->check(2), 'but 2 is!';
  95
  96     ok subtype( IntLessThan,
  97         as Parameterizable[EvenInt, Maybe[Int]],
  98         where {
  99             my $value = shift @_;
 100             my $constraining = shift @_ || 200;
 101             return ($value < $constraining && $value > 5);
 102         }),
 103       'Created IntLessThan subtype';
 104
 105     ok !IntLessThan->check('aaa'),
 106       '"aaa" is not an integer';
 107
 108     like IntLessThan->validate('aaa'),
 109       qr/Validation failed for 'main::EvenInt' with value .*aaa.*/,
 110       'Got expected error messge for "aaa"';
 111
 112     ok !IntLessThan->check(1),
 113       '1 smaller than 5';
 114
 115     ok !IntLessThan->check(2),
 116       '2 smaller than 5';
 117
 118     ok !IntLessThan->check(15),
 119       '15 greater than 5 (but odd)';
 120
 121     ok !IntLessThan->check(301),
 122       '301 is too big';
 123
 124     ok !IntLessThan->check(400),
 125       '400 is too big';
 126
 127     ok IntLessThan->check(10),
 128       '10 greater than 5 (and even)';
 129
 130     like IntLessThan->validate(1),
 131       qr/Validation failed for 'main::EvenInt' with value 1/,
 132       'error message is correct';
 133
 134     is IntLessThan->name, 'main::IntLessThan',
 135       'Got correct name for IntLessThan';
 136
 137     is IntLessThan->parent, 'MooseX::Types::Parameterizable::Parameterizable[main::EvenInt, Maybe[Int]]',
 138       'IntLessThan is a Parameterizable';
 139
 140     is IntLessThan->parent_type_constraint, EvenInt,
 141       'Parent is an Int';
 142
 143     is IntLessThan->constraining_value_type_constraint, (Maybe[Int]),
 144       'constraining is an Int';
 145
 146     ok IntLessThan->equals(IntLessThan),
 147       'IntLessThan equals IntLessThan';
 148
 149     ok IntLessThan->is_subtype_of(Parameterizable),
 150       'IntLessThan is_subtype_of Parameterizable';
 151
 152     ok IntLessThan->is_subtype_of(Int),
 153       'IntLessThan is_subtype_of Int';
 154
 155     ok IntLessThan->is_a_type_of(Parameterizable),
 156       'IntLessThan is_a_type_of Parameterizable';
 157
 158     ok IntLessThan->is_a_type_of(Int),
 159       'IntLessThan is_a_type_of Int';
 160
 161     ok IntLessThan->is_a_type_of(IntLessThan),
 162       'IntLessThan is_a_type_of IntLessThan';
 163
 164     ok( (my $lessThan100GreatThen5andEvenInt = IntLessThan[100]),
 165        'Parameterized!');
 166
 167     ok !$lessThan100GreatThen5andEvenInt->check(150),
 168       '150 Not less than 100';
 169
 170     ok !$lessThan100GreatThen5andEvenInt->check(151),
 171       '151 Not less than 100';
 172
 173     ok !$lessThan100GreatThen5andEvenInt->check(2),
 174       'Not greater than 5';
 175
 176     ok !$lessThan100GreatThen5andEvenInt->check(51),
 177       'Not even';
 178
 179     ok !$lessThan100GreatThen5andEvenInt->check('aaa'),
 180       'Not Int';
 181
 182     ok $lessThan100GreatThen5andEvenInt->check(42),
 183       'is Int, is even, greater than 5, less than 100';
 184
 185     ok subtype( LessThan100GreatThen5andEvenIntNot44,
 186         as IntLessThan[100],
 187         where {
 188             my $value = shift @_;
 189             return $value != 44;
 190         }),
 191       'Created LessThan100GreatThen5andEvenIntNot44 subtype';
 192
 193     ok !LessThan100GreatThen5andEvenIntNot44->check(150),
 194       '150 Not less than 100';
 195
 196     ok !LessThan100GreatThen5andEvenIntNot44->check(300),
 197       '300 Not less than 100 (check to make sure we are not defaulting 200)';
 198
 199     ok !LessThan100GreatThen5andEvenIntNot44->check(151),
 200       '151 Not less than 100';
 201
 202     ok !LessThan100GreatThen5andEvenIntNot44->check(2),
 203       'Not greater than 5';
 204
 205     ok !LessThan100GreatThen5andEvenIntNot44->check(51),
 206       'Not even';
 207
 208     ok !LessThan100GreatThen5andEvenIntNot44->check('aaa'),
 209       'Not Int';
 210
 211     ok LessThan100GreatThen5andEvenIntNot44->check(42),
 212       'is Int, is even, greater than 5, less than 100';
 213
 214     ok !LessThan100GreatThen5andEvenIntNot44->check(44),
 215       'is Int, is even, greater than 5, less than 100 BUT 44!';
 216
 217     ok subtype( IntNot54,
 218         as Maybe[Int],
 219         where {
 220             my $val = shift @_ || 200;
 221             return $val != 54
 222         }),
 223       'Created a subtype of Int';
 224
 225     ok IntNot54->check(100), 'Not 54';
 226     ok !IntNot54->check(54), '54!!';
 227
 228     ok( subtype( GreatThen5andEvenIntNot54or64,
 229         as IntLessThan[IntNot54],
 230         where {
 231             my $value = shift @_;
 232             return $value != 64;
 233         }),
 234       'Created GreatThen5andEvenIntNot54or64 subtype');
 235
 236     is( (GreatThen5andEvenIntNot54or64->name),
 237        'main::GreatThen5andEvenIntNot54or64',
 238        'got expected name');
 239
 240     ok GreatThen5andEvenIntNot54or64->check(150),
 241         '150 is even, less than 200, not 54 or 64 but > 5';
 242
 243     ok !GreatThen5andEvenIntNot54or64->check(202),
 244         '202 is even, exceeds 200, not 54 or 64 but > 5';
 245
 246     is( ((GreatThen5andEvenIntNot54or64[100])->name),
 247       'main::GreatThen5andEvenIntNot54or64[100]',
 248       'got expected name');
 249
 250     ok !GreatThen5andEvenIntNot54or64([100])->check(150),
 251       '150 Not less than 100';
 252
 253     ok !GreatThen5andEvenIntNot54or64([100])->check(300),
 254       '300 Not less than 100 (check to make sure we are not defaulting 200)';
 255
 256     ok !GreatThen5andEvenIntNot54or64([100])->check(151),
 257       '151 Not less than 100';
 258
 259     ok !GreatThen5andEvenIntNot54or64([100])->check(2),
 260       'Not greater than 5';
 261
 262     ok !GreatThen5andEvenIntNot54or64([100])->check(51),
 263       'Not even';
 264
 265     ok !GreatThen5andEvenIntNot54or64([100])->check('aaa'),
 266       'Not Int';
 267
 268     ok GreatThen5andEvenIntNot54or64([100])->check(42),
 269       'is Int, is even, greater than 5, less than 100';
 270
 271     ok !GreatThen5andEvenIntNot54or64([100])->check(64),
 272       'is Int, is even, greater than 5, less than 100 BUT 64!';
 273
 274     CHECKPARAM: {
 275         eval { GreatThen5andEvenIntNot54or64([54])->check(32) };
 276         like $@,
 277           qr/Validation failed for 'main::IntNot54' with value 54/,
 278           'Got Expected Error';
 279     }
 280 }