0.01 24 June 2010
- Completed basic requirements, documentation and tests.
- - sending this out from YAPC::NA, while in a talk on extending
- Moose :)
+ - sending this out from YAPC::NA, while in a talk on extending
+ Moose :)
use MooseX::Types::Parameterizable qw(Parameterizable);
subtype Set,
- as class_type("Set::Scalar");
+ as class_type("Set::Scalar");
subtype UniqueInt,
as Parameterizable[Int, Set],
my ($int, $set) = @_;
return !$set->has($int);
};
-
+
subtype PositiveSet,
- as Set,
- where {
- my ($set) = @_;
- return !grep {$_ <0 } $set->members;
- };
-
+ as Set,
+ where {
+ my ($set) = @_;
+ return !grep {$_ <0 } $set->members;
+ };
+
subtype PositiveUniqueInt,
as UniqueInt[PositiveSet];
my $negative_set = Set::Scalar->new(-1,-2,-3);
UniqueInt([$negative_set])->check(100); ## Throws exception
-
+
=head1 DESCRIPTION
A L<MooseX::Types> library for creating parameterizable types. A parameterizable type
for a integer, such as in:
subtype Range,
- as Dict[max=>Int, min=>Int],
- where {
- my ($range) = @_;
- return $range->{max} > $range->{min};
- };
+ as Dict[max=>Int, min=>Int],
+ where {
+ my ($range) = @_;
+ return $range->{max} > $range->{min};
+ };
subtype RangedInt,
- as Parameterizable[Int, Range],
- where {
- my ($value, $range) = @_;
- return ($value >= $range->{min} &&
- $value <= $range->{max});
- };
-
+ as Parameterizable[Int, Range],
+ where {
+ my ($value, $range) = @_;
+ return ($value >= $range->{min} &&
+ $value <= $range->{max});
+ };
+
RangedInt([{min=>10,max=>100}])->check(50); ## OK
RangedInt([{min=>50, max=>75}])->check(99); ## Not OK, 99 exceeds max
my $range = {min=>99, max=>10};
if(my $err = Range->validate($range)) {
- ## Handle #$err
+ ## Handle #$err
} else {
- RangedInt($range)->check(99);
+ RangedInt($range)->check(99);
}
Please note that for ArrayRef or HashRef parameterizable type constraints, as in the
type constraints are a subtype of the parent. For example:
subtype RangedInt,
- as Parameterizable[Int, Range],
- where {
- my ($value, $range) = @_;
- return ($value >= $range->{min} &&
- $value =< $range->{max});
- };
+ as Parameterizable[Int, Range],
+ where {
+ my ($value, $range) = @_;
+ return ($value >= $range->{min} &&
+ $value =< $range->{max});
+ };
Example subtype with additional constraints:
subtype PositiveRangedInt,
- as RangedInt,
- where {
- shift >= 0;
- };
-
+ as RangedInt,
+ where {
+ shift >= 0;
+ };
+
Or you could have done the following instead:
## Subtype of Int for positive numbers
subtype PositiveInt,
- as Int,
- where {
- my ($value, $range) = @_;
- return $value >= 0;
- };
+ as Int,
+ where {
+ my ($value, $range) = @_;
+ return $value >= 0;
+ };
## subtype Range to re-parameterize Range with subtypes
subtype PositiveRange,
- as Range[max=>PositiveInt, min=>PositiveInt];
+ as Range[max=>PositiveInt, min=>PositiveInt];
## create subtype via reparameterizing
subtype PositiveRangedInt,
- as RangedInt[PositiveRange];
+ as RangedInt[PositiveRange];
Notice how re-parameterizing the parameterizable type 'RangedInt' works slightly
differently from re-parameterizing 'PositiveRange' Although it initially takes
all intends and uses you could stick it wherever you'd need an Int.
subtype NameAge,
- as Tuple[Str, Int];
+ as Tuple[Str, Int];
- ## re-parameterized subtypes of NameAge containing a Parameterizable Int
+ ## re-parameterized subtypes of NameAge containing a Parameterizable Int
subtype NameBetween18and35Age,
- as NameAge[
- Str,
- PositiveRangedInt[min=>18,max=>35],
- ];
+ as NameAge[
+ Str,
+ PositiveRangedInt[min=>18,max=>35],
+ ];
One caveat is that you can't stick an unparameterized parameterizable type inside a
structure, such as L<MooseX::Types::Structured> since that would require the
subtype PersonOverAge,
as Parameterizable[Person, RequiredAgeInYears]
where {
- my ($person, $required_years_old) = @_;
- return $person->years_old > $required_years_old;
+ my ($person, $required_years_old) = @_;
+ return $person->years_old > $required_years_old;
}
This would validate the following:
## Create a type constraint where a Person must be in the set
subtype PersonInSet,
- as Parameterizable[Person, PersonSet],
- where {
- my ($person, $person_set) = @_;
- $person_set->find($person);
- }
+ as Parameterizable[Person, PersonSet],
+ where {
+ my ($person, $person_set) = @_;
+ $person_set->find($person);
+ }
coerce PersonInSet,
- from HashRef,
- via {
- my ($hashref, $person_set) = @_;
- return $person_set->create($hash_ref);
- };
+ from HashRef,
+ via {
+ my ($hashref, $person_set) = @_;
+ return $person_set->create($hash_ref);
+ };
=head2 Recursion
MooseX::Meta::TypeConstraint::Parameterizable->new(
name => 'MooseX::Types::Parameterizable::Parameterizable',
parent => find_type_constraint('Any'),
- constraint => sub {1},
+ constraint => sub {1},
)
);
use Test::More tests=>79; {
-
- use strict;
- use warnings;
-
- use MooseX::Types::Parameterizable qw(Parameterizable);
- use MooseX::Types::Moose qw(Int Any Maybe);
- use Moose::Util::TypeConstraints;
-
- use MooseX::Types -declare=>[qw(SubParameterizable IntLessThan EvenInt
- LessThan100GreatThen5andEvenIntNot44 IntNot54
- GreatThen5andEvenIntNot54or64)];
-
- ok Parameterizable->check(1),
- 'Parameterizable is basically an "Any"';
-
- is Parameterizable->validate(1), undef,
- 'No Error Message';
-
- is Parameterizable->parent, 'Any',
- 'Parameterizable is an Any';
-
- is Parameterizable->name, 'MooseX::Types::Parameterizable::Parameterizable',
- 'Parameterizable has expected name';
-
- like Parameterizable->get_message,
- qr/Validation failed for 'MooseX::Types::Parameterizable::Parameterizable' with value undef/,
- 'Got Expected Message';
-
- ok Parameterizable->equals(Parameterizable),
- 'Parameterizable equal Parameterizable';
-
- ok Parameterizable->is_a_type_of(Parameterizable),
- 'Parameterizable is_a_type_of Parameterizable';
-
- ok Parameterizable->is_a_type_of('Any'),
- 'Parameterizable is_a_type_of Any';
-
- ok Parameterizable->is_subtype_of('Any'),
- 'Parameterizable is_subtype_of Parameterizable';
+
+ use strict;
+ use warnings;
+
+ use MooseX::Types::Parameterizable qw(Parameterizable);
+ use MooseX::Types::Moose qw(Int Any Maybe);
+ use Moose::Util::TypeConstraints;
+
+ use MooseX::Types -declare=>[qw(SubParameterizable IntLessThan EvenInt
+ LessThan100GreatThen5andEvenIntNot44 IntNot54
+ GreatThen5andEvenIntNot54or64)];
+
+ ok Parameterizable->check(1),
+ 'Parameterizable is basically an "Any"';
+
+ is Parameterizable->validate(1), undef,
+ 'No Error Message';
+
+ is Parameterizable->parent, 'Any',
+ 'Parameterizable is an Any';
+
+ is Parameterizable->name, 'MooseX::Types::Parameterizable::Parameterizable',
+ 'Parameterizable has expected name';
+
+ like Parameterizable->get_message,
+ qr/Validation failed for 'MooseX::Types::Parameterizable::Parameterizable' with value undef/,
+ 'Got Expected Message';
+
+ ok Parameterizable->equals(Parameterizable),
+ 'Parameterizable equal Parameterizable';
+
+ ok Parameterizable->is_a_type_of(Parameterizable),
+ 'Parameterizable is_a_type_of Parameterizable';
+
+ ok Parameterizable->is_a_type_of('Any'),
+ 'Parameterizable is_a_type_of Any';
+
+ ok Parameterizable->is_subtype_of('Any'),
+ 'Parameterizable is_subtype_of Parameterizable';
- is Parameterizable->parent_type_constraint, 'Any',
- 'Correct parent type';
+ is Parameterizable->parent_type_constraint, 'Any',
+ 'Correct parent type';
- is subtype( SubParameterizable, as Parameterizable ),
- 'main::SubParameterizable',
- 'Create a useless subtype';
+ is subtype( SubParameterizable, as Parameterizable ),
+ 'main::SubParameterizable',
+ 'Create a useless subtype';
- ok SubParameterizable->check(1),
- 'SubParameterizable is basically an "Any"';
-
- is SubParameterizable->validate(1), undef,
- 'validate returned no error message';
+ ok SubParameterizable->check(1),
+ 'SubParameterizable is basically an "Any"';
+
+ is SubParameterizable->validate(1), undef,
+ 'validate returned no error message';
- is SubParameterizable->parent, 'MooseX::Types::Parameterizable::Parameterizable',
- 'SubParameterizable is a Parameterizable';
-
- is SubParameterizable->name, 'main::SubParameterizable',
- 'Parameterizable has expected name';
-
- like SubParameterizable->get_message,
- qr/Validation failed for 'main::SubParameterizable' with value undef/,
- 'Got Expected Message';
-
- ok SubParameterizable->equals(SubParameterizable),
- 'SubParameterizable equal SubParameterizable';
-
- ok !SubParameterizable->equals(Parameterizable),
- 'SubParameterizable does not equal Parameterizable';
-
- ok SubParameterizable->is_a_type_of(Parameterizable),
- 'SubParameterizable is_a_type_of Parameterizable';
-
- ok SubParameterizable->is_a_type_of(Any),
- 'SubParameterizable is_a_type_of Any';
-
- ok SubParameterizable->is_subtype_of('Any'),
- 'SubParameterizable is_subtype_of Parameterizable';
-
- ok !SubParameterizable->is_subtype_of(SubParameterizable),
- 'SubParameterizable is not is_subtype_of SubParameterizable';
-
- ok subtype( EvenInt,
- as Int,
- where {
- my $val = shift @_;
- return $val % 2 ? 0:1;
- }),
- 'Created a subtype of Int';
+ is SubParameterizable->parent, 'MooseX::Types::Parameterizable::Parameterizable',
+ 'SubParameterizable is a Parameterizable';
+
+ is SubParameterizable->name, 'main::SubParameterizable',
+ 'Parameterizable has expected name';
+
+ like SubParameterizable->get_message,
+ qr/Validation failed for 'main::SubParameterizable' with value undef/,
+ 'Got Expected Message';
+
+ ok SubParameterizable->equals(SubParameterizable),
+ 'SubParameterizable equal SubParameterizable';
+
+ ok !SubParameterizable->equals(Parameterizable),
+ 'SubParameterizable does not equal Parameterizable';
+
+ ok SubParameterizable->is_a_type_of(Parameterizable),
+ 'SubParameterizable is_a_type_of Parameterizable';
+
+ ok SubParameterizable->is_a_type_of(Any),
+ 'SubParameterizable is_a_type_of Any';
+
+ ok SubParameterizable->is_subtype_of('Any'),
+ 'SubParameterizable is_subtype_of Parameterizable';
+
+ ok !SubParameterizable->is_subtype_of(SubParameterizable),
+ 'SubParameterizable is not is_subtype_of SubParameterizable';
+
+ ok subtype( EvenInt,
+ as Int,
+ where {
+ my $val = shift @_;
+ return $val % 2 ? 0:1;
+ }),
+ 'Created a subtype of Int';
- ok !EvenInt->check('aaa'), '"aaa" not an Int';
- ok !EvenInt->check(1), '1 is not even';
- ok EvenInt->check(2), 'but 2 is!';
-
- ok subtype( IntLessThan,
- as Parameterizable[EvenInt, Maybe[Int]],
- where {
- my $value = shift @_;
- my $constraining = shift @_ || 200;
- return ($value < $constraining && $value > 5);
- }),
- 'Created IntLessThan subtype';
-
- ok !IntLessThan->check('aaa'),
- '"aaa" is not an integer';
-
- like IntLessThan->validate('aaa'),
- qr/Validation failed for 'main::EvenInt' with value aaa/,
- 'Got expected error messge for "aaa"';
-
- ok !IntLessThan->check(1),
- '1 smaller than 5';
+ ok !EvenInt->check('aaa'), '"aaa" not an Int';
+ ok !EvenInt->check(1), '1 is not even';
+ ok EvenInt->check(2), 'but 2 is!';
+
+ ok subtype( IntLessThan,
+ as Parameterizable[EvenInt, Maybe[Int]],
+ where {
+ my $value = shift @_;
+ my $constraining = shift @_ || 200;
+ return ($value < $constraining && $value > 5);
+ }),
+ 'Created IntLessThan subtype';
+
+ ok !IntLessThan->check('aaa'),
+ '"aaa" is not an integer';
+
+ like IntLessThan->validate('aaa'),
+ qr/Validation failed for 'main::EvenInt' with value aaa/,
+ 'Got expected error messge for "aaa"';
+
+ ok !IntLessThan->check(1),
+ '1 smaller than 5';
- ok !IntLessThan->check(2),
- '2 smaller than 5';
-
- ok !IntLessThan->check(15),
- '15 greater than 5 (but odd)';
+ ok !IntLessThan->check(2),
+ '2 smaller than 5';
+
+ ok !IntLessThan->check(15),
+ '15 greater than 5 (but odd)';
- ok !IntLessThan->check(301),
- '301 is too big';
-
- ok !IntLessThan->check(400),
- '400 is too big';
-
- ok IntLessThan->check(10),
- '10 greater than 5 (and even)';
-
- like IntLessThan->validate(1),
- qr/Validation failed for 'main::EvenInt' with value 1/,
- 'error message is correct';
-
- is IntLessThan->name, 'main::IntLessThan',
- 'Got correct name for IntLessThan';
-
- is IntLessThan->parent, 'MooseX::Types::Parameterizable::Parameterizable[main::EvenInt, Maybe[Int]]',
- 'IntLessThan is a Parameterizable';
-
- is IntLessThan->parent_type_constraint, EvenInt,
- 'Parent is an Int';
-
- is IntLessThan->constraining_value_type_constraint, (Maybe[Int]),
- 'constraining is an Int';
-
- ok IntLessThan->equals(IntLessThan),
- 'IntLessThan equals IntLessThan';
+ ok !IntLessThan->check(301),
+ '301 is too big';
+
+ ok !IntLessThan->check(400),
+ '400 is too big';
+
+ ok IntLessThan->check(10),
+ '10 greater than 5 (and even)';
+
+ like IntLessThan->validate(1),
+ qr/Validation failed for 'main::EvenInt' with value 1/,
+ 'error message is correct';
+
+ is IntLessThan->name, 'main::IntLessThan',
+ 'Got correct name for IntLessThan';
+
+ is IntLessThan->parent, 'MooseX::Types::Parameterizable::Parameterizable[main::EvenInt, Maybe[Int]]',
+ 'IntLessThan is a Parameterizable';
+
+ is IntLessThan->parent_type_constraint, EvenInt,
+ 'Parent is an Int';
+
+ is IntLessThan->constraining_value_type_constraint, (Maybe[Int]),
+ 'constraining is an Int';
+
+ ok IntLessThan->equals(IntLessThan),
+ 'IntLessThan equals IntLessThan';
- ok IntLessThan->is_subtype_of(Parameterizable),
- 'IntLessThan is_subtype_of Parameterizable';
+ ok IntLessThan->is_subtype_of(Parameterizable),
+ 'IntLessThan is_subtype_of Parameterizable';
- ok IntLessThan->is_subtype_of(Int),
- 'IntLessThan is_subtype_of Int';
+ ok IntLessThan->is_subtype_of(Int),
+ 'IntLessThan is_subtype_of Int';
- ok IntLessThan->is_a_type_of(Parameterizable),
- 'IntLessThan is_a_type_of Parameterizable';
+ ok IntLessThan->is_a_type_of(Parameterizable),
+ 'IntLessThan is_a_type_of Parameterizable';
- ok IntLessThan->is_a_type_of(Int),
- 'IntLessThan is_a_type_of Int';
+ ok IntLessThan->is_a_type_of(Int),
+ 'IntLessThan is_a_type_of Int';
- ok IntLessThan->is_a_type_of(IntLessThan),
- 'IntLessThan is_a_type_of IntLessThan';
-
- ok( (my $lessThan100GreatThen5andEvenInt = IntLessThan[100]),
- 'Parameterized!');
-
- ok !$lessThan100GreatThen5andEvenInt->check(150),
- '150 Not less than 100';
-
- ok !$lessThan100GreatThen5andEvenInt->check(151),
- '151 Not less than 100';
-
- ok !$lessThan100GreatThen5andEvenInt->check(2),
- 'Not greater than 5';
+ ok IntLessThan->is_a_type_of(IntLessThan),
+ 'IntLessThan is_a_type_of IntLessThan';
+
+ ok( (my $lessThan100GreatThen5andEvenInt = IntLessThan[100]),
+ 'Parameterized!');
+
+ ok !$lessThan100GreatThen5andEvenInt->check(150),
+ '150 Not less than 100';
+
+ ok !$lessThan100GreatThen5andEvenInt->check(151),
+ '151 Not less than 100';
+
+ ok !$lessThan100GreatThen5andEvenInt->check(2),
+ 'Not greater than 5';
- ok !$lessThan100GreatThen5andEvenInt->check(51),
- 'Not even';
+ ok !$lessThan100GreatThen5andEvenInt->check(51),
+ 'Not even';
- ok !$lessThan100GreatThen5andEvenInt->check('aaa'),
- 'Not Int';
-
- ok $lessThan100GreatThen5andEvenInt->check(42),
- 'is Int, is even, greater than 5, less than 100';
+ ok !$lessThan100GreatThen5andEvenInt->check('aaa'),
+ 'Not Int';
+
+ ok $lessThan100GreatThen5andEvenInt->check(42),
+ 'is Int, is even, greater than 5, less than 100';
- ok subtype( LessThan100GreatThen5andEvenIntNot44,
- as IntLessThan[100],
- where {
- my $value = shift @_;
- return $value != 44;
- }),
- 'Created LessThan100GreatThen5andEvenIntNot44 subtype';
+ ok subtype( LessThan100GreatThen5andEvenIntNot44,
+ as IntLessThan[100],
+ where {
+ my $value = shift @_;
+ return $value != 44;
+ }),
+ 'Created LessThan100GreatThen5andEvenIntNot44 subtype';
- ok !LessThan100GreatThen5andEvenIntNot44->check(150),
- '150 Not less than 100';
-
- ok !LessThan100GreatThen5andEvenIntNot44->check(300),
- '300 Not less than 100 (check to make sure we are not defaulting 200)';
-
- ok !LessThan100GreatThen5andEvenIntNot44->check(151),
- '151 Not less than 100';
-
- ok !LessThan100GreatThen5andEvenIntNot44->check(2),
- 'Not greater than 5';
+ ok !LessThan100GreatThen5andEvenIntNot44->check(150),
+ '150 Not less than 100';
+
+ ok !LessThan100GreatThen5andEvenIntNot44->check(300),
+ '300 Not less than 100 (check to make sure we are not defaulting 200)';
+
+ ok !LessThan100GreatThen5andEvenIntNot44->check(151),
+ '151 Not less than 100';
+
+ ok !LessThan100GreatThen5andEvenIntNot44->check(2),
+ 'Not greater than 5';
- ok !LessThan100GreatThen5andEvenIntNot44->check(51),
- 'Not even';
+ ok !LessThan100GreatThen5andEvenIntNot44->check(51),
+ 'Not even';
- ok !LessThan100GreatThen5andEvenIntNot44->check('aaa'),
- 'Not Int';
-
- ok LessThan100GreatThen5andEvenIntNot44->check(42),
- 'is Int, is even, greater than 5, less than 100';
+ ok !LessThan100GreatThen5andEvenIntNot44->check('aaa'),
+ 'Not Int';
+
+ ok LessThan100GreatThen5andEvenIntNot44->check(42),
+ 'is Int, is even, greater than 5, less than 100';
- ok !LessThan100GreatThen5andEvenIntNot44->check(44),
- 'is Int, is even, greater than 5, less than 100 BUT 44!';
-
- ok subtype( IntNot54,
- as Maybe[Int],
- where {
- my $val = shift @_ || 200;
- return $val != 54
- }),
- 'Created a subtype of Int';
-
- ok IntNot54->check(100), 'Not 54';
- ok !IntNot54->check(54), '54!!';
-
- ok( subtype( GreatThen5andEvenIntNot54or64,
- as IntLessThan[IntNot54],
- where {
- my $value = shift @_;
- return $value != 64;
- }),
- 'Created GreatThen5andEvenIntNot54or64 subtype');
-
- is( (GreatThen5andEvenIntNot54or64->name),
- 'main::GreatThen5andEvenIntNot54or64',
- 'got expected name');
-
- ok GreatThen5andEvenIntNot54or64->check(150),
- '150 is even, less than 200, not 54 or 64 but > 5';
+ ok !LessThan100GreatThen5andEvenIntNot44->check(44),
+ 'is Int, is even, greater than 5, less than 100 BUT 44!';
+
+ ok subtype( IntNot54,
+ as Maybe[Int],
+ where {
+ my $val = shift @_ || 200;
+ return $val != 54
+ }),
+ 'Created a subtype of Int';
+
+ ok IntNot54->check(100), 'Not 54';
+ ok !IntNot54->check(54), '54!!';
+
+ ok( subtype( GreatThen5andEvenIntNot54or64,
+ as IntLessThan[IntNot54],
+ where {
+ my $value = shift @_;
+ return $value != 64;
+ }),
+ 'Created GreatThen5andEvenIntNot54or64 subtype');
+
+ is( (GreatThen5andEvenIntNot54or64->name),
+ 'main::GreatThen5andEvenIntNot54or64',
+ 'got expected name');
+
+ ok GreatThen5andEvenIntNot54or64->check(150),
+ '150 is even, less than 200, not 54 or 64 but > 5';
- ok !GreatThen5andEvenIntNot54or64->check(202),
- '202 is even, exceeds 200, not 54 or 64 but > 5';
-
- is( ((GreatThen5andEvenIntNot54or64[100])->name),
- 'main::GreatThen5andEvenIntNot54or64[100]',
- 'got expected name');
-
- ok !GreatThen5andEvenIntNot54or64([100])->check(150),
- '150 Not less than 100';
-
- ok !GreatThen5andEvenIntNot54or64([100])->check(300),
- '300 Not less than 100 (check to make sure we are not defaulting 200)';
-
- ok !GreatThen5andEvenIntNot54or64([100])->check(151),
- '151 Not less than 100';
-
- ok !GreatThen5andEvenIntNot54or64([100])->check(2),
- 'Not greater than 5';
+ ok !GreatThen5andEvenIntNot54or64->check(202),
+ '202 is even, exceeds 200, not 54 or 64 but > 5';
+
+ is( ((GreatThen5andEvenIntNot54or64[100])->name),
+ 'main::GreatThen5andEvenIntNot54or64[100]',
+ 'got expected name');
+
+ ok !GreatThen5andEvenIntNot54or64([100])->check(150),
+ '150 Not less than 100';
+
+ ok !GreatThen5andEvenIntNot54or64([100])->check(300),
+ '300 Not less than 100 (check to make sure we are not defaulting 200)';
+
+ ok !GreatThen5andEvenIntNot54or64([100])->check(151),
+ '151 Not less than 100';
+
+ ok !GreatThen5andEvenIntNot54or64([100])->check(2),
+ 'Not greater than 5';
- ok !GreatThen5andEvenIntNot54or64([100])->check(51),
- 'Not even';
+ ok !GreatThen5andEvenIntNot54or64([100])->check(51),
+ 'Not even';
- ok !GreatThen5andEvenIntNot54or64([100])->check('aaa'),
- 'Not Int';
-
- ok GreatThen5andEvenIntNot54or64([100])->check(42),
- 'is Int, is even, greater than 5, less than 100';
-
- ok !GreatThen5andEvenIntNot54or64([100])->check(64),
- 'is Int, is even, greater than 5, less than 100 BUT 64!';
-
- CHECKPARAM: {
- eval { GreatThen5andEvenIntNot54or64([54])->check(32) };
- like $@,
- qr/Validation failed for 'main::IntNot54' with value 54/,
- 'Got Expected Error';
- }
+ ok !GreatThen5andEvenIntNot54or64([100])->check('aaa'),
+ 'Not Int';
+
+ ok GreatThen5andEvenIntNot54or64([100])->check(42),
+ 'is Int, is even, greater than 5, less than 100';
+
+ ok !GreatThen5andEvenIntNot54or64([100])->check(64),
+ 'is Int, is even, greater than 5, less than 100 BUT 64!';
+
+ CHECKPARAM: {
+ eval { GreatThen5andEvenIntNot54or64([54])->check(32) };
+ like $@,
+ qr/Validation failed for 'main::IntNot54' with value 54/,
+ 'Got Expected Error';
+ }
}
use Test::More; {
-
- use strict;
- use warnings;
-
- eval "use MooseX::Types::Structured"; if($@) {
- plan skip_all => "MooseX::Types:Structured Required for advanced Tests";
- } else {
- eval "use Set::Scalar"; if($@) {
- plan skip_all => "Set::Scalar Required for advanced Tests";
- } else {
- plan tests => 37;
- }
- }
+
+ use strict;
+ use warnings;
+
+ eval "use MooseX::Types::Structured"; if($@) {
+ plan skip_all => "MooseX::Types:Structured Required for advanced Tests";
+ } else {
+ eval "use Set::Scalar"; if($@) {
+ plan skip_all => "Set::Scalar Required for advanced Tests";
+ } else {
+ plan tests => 37;
+ }
+ }
- use MooseX::Types::Structured qw(Tuple Dict slurpy);
- use MooseX::Types::Parameterizable qw(Parameterizable);
- use MooseX::Types::Moose qw(Int Str);
- use Moose::Util::TypeConstraints;
-
- use MooseX::Types -declare=>[qw(
- Set UniqueInt UniqueInSet Range RangedInt PositiveRangedInt1
- PositiveRangedInt2 PositiveInt PositiveRange NameAge NameBetween18and35Age
- )];
-
- ok class_type("Set::Scalar"), 'Created Set::Scalar class_type';
- ok subtype( Set, as "Set::Scalar"), 'Created Set subtype';
-
- ok subtype( UniqueInt,
- as Parameterizable[Int, Set],
- where {
- my ($int, $set) = @_;
- return !$set->has($int);
- }), 'Created UniqueInt Parameterizable Type';
-
- ok( (my $set_obj = Set::Scalar->new(1,2,3,4,5)), 'Create Set Object');
-
+ use MooseX::Types::Structured qw(Tuple Dict slurpy);
+ use MooseX::Types::Parameterizable qw(Parameterizable);
+ use MooseX::Types::Moose qw(Int Str);
+ use Moose::Util::TypeConstraints;
+
+ use MooseX::Types -declare=>[qw(
+ Set UniqueInt UniqueInSet Range RangedInt PositiveRangedInt1
+ PositiveRangedInt2 PositiveInt PositiveRange NameAge NameBetween18and35Age
+ )];
+
+ ok class_type("Set::Scalar"), 'Created Set::Scalar class_type';
+ ok subtype( Set, as "Set::Scalar"), 'Created Set subtype';
+
+ ok subtype( UniqueInt,
+ as Parameterizable[Int, Set],
+ where {
+ my ($int, $set) = @_;
+ return !$set->has($int);
+ }), 'Created UniqueInt Parameterizable Type';
+
+ ok( (my $set_obj = Set::Scalar->new(1,2,3,4,5)), 'Create Set Object');
+
ok !UniqueInt([$set_obj])->check(1), "Not OK, since one isn't unique in $set_obj";
- ok !UniqueInt([$set_obj])->check('AAA'), "Not OK, since AAA is not an Int";
+ ok !UniqueInt([$set_obj])->check('AAA'), "Not OK, since AAA is not an Int";
ok UniqueInt([$set_obj])->check(100), "OK, since 100 isn't in the set";
-
+
ok( (my $unique = UniqueInt[$set_obj]), 'Created Anonymous typeconstraint');
ok $unique->check(10), "OK, 10 is unique";
ok !$unique->check(2), "Not OK, '2' is already in the set";
ok( subtype(UniqueInSet, as UniqueInt[$set_obj]), 'Created Subtype');
ok UniqueInSet->check(99), '99 is unique';
ok !UniqueInSet->check(3), 'Not OK, 3 is already in the set';
-
- CHECKHARDEXCEPTION: {
- eval { UniqueInt->check(1000) };
- like $@,
- qr/Validation failed for 'main::Set' failed with value undef/,
- 'Got Expected Error';
-
- eval { UniqueInt->validate(1000) };
- like $@,
- qr/Validation failed for 'main::Set' failed with value undef/,
- 'Got Expected Error';
- }
-
- subtype Range,
- as Dict[max=>Int, min=>Int],
- where {
- my ($range) = @_;
- return $range->{max} > $range->{min};
- };
+
+ CHECKHARDEXCEPTION: {
+ eval { UniqueInt->check(1000) };
+ like $@,
+ qr/Validation failed for 'main::Set' failed with value undef/,
+ 'Got Expected Error';
+
+ eval { UniqueInt->validate(1000) };
+ like $@,
+ qr/Validation failed for 'main::Set' failed with value undef/,
+ 'Got Expected Error';
+ }
+
+ subtype Range,
+ as Dict[max=>Int, min=>Int],
+ where {
+ my ($range) = @_;
+ return $range->{max} > $range->{min};
+ };
- subtype RangedInt,
- as Parameterizable[Int, Range],
- where {
- my ($value, $range) = @_;
- return ($value >= $range->{min} &&
- $value <= $range->{max});
- };
-
- ok RangedInt([{min=>10,max=>100}])->check(50), '50 in the range';
- ok !RangedInt([{min=>50, max=>75}])->check(99),'99 exceeds max';
- ok !RangedInt([{min=>50, max=>75}])->check('aa'), '"aa" not even an Int';
+ subtype RangedInt,
+ as Parameterizable[Int, Range],
+ where {
+ my ($value, $range) = @_;
+ return ($value >= $range->{min} &&
+ $value <= $range->{max});
+ };
+
+ ok RangedInt([{min=>10,max=>100}])->check(50), '50 in the range';
+ ok !RangedInt([{min=>50, max=>75}])->check(99),'99 exceeds max';
+ ok !RangedInt([{min=>50, max=>75}])->check('aa'), '"aa" not even an Int';
- CHECKRANGEDINT: {
- eval {
- RangedInt([{min=>99, max=>10}])->check(10); ## Not OK, not a valid Range!
- };
-
- like $@,
- qr/Validation failed for 'main::Range'/,
- 'Got Expected Error';
- }
+ CHECKRANGEDINT: {
+ eval {
+ RangedInt([{min=>99, max=>10}])->check(10); ## Not OK, not a valid Range!
+ };
+
+ like $@,
+ qr/Validation failed for 'main::Range'/,
+ 'Got Expected Error';
+ }
- ok RangedInt([min=>10,max=>100])->check(50), '50 in the range';
- ok !RangedInt([min=>50, max=>75])->check(99),'99 exceeds max';
- ok !RangedInt([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
+ ok RangedInt([min=>10,max=>100])->check(50), '50 in the range';
+ ok !RangedInt([min=>50, max=>75])->check(99),'99 exceeds max';
+ ok !RangedInt([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
- CHECKRANGEDINT2: {
- eval {
- RangedInt([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
- };
-
- like $@,
- qr/Validation failed for 'main::Range'/,
- 'Got Expected Error';
- }
+ CHECKRANGEDINT2: {
+ eval {
+ RangedInt([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
+ };
+
+ like $@,
+ qr/Validation failed for 'main::Range'/,
+ 'Got Expected Error';
+ }
- subtype PositiveRangedInt1,
- as RangedInt,
- where {
- shift >= 0;
- };
+ subtype PositiveRangedInt1,
+ as RangedInt,
+ where {
+ shift >= 0;
+ };
- ok PositiveRangedInt1([min=>10,max=>100])->check(50), '50 in the range';
- ok !PositiveRangedInt1([min=>50, max=>75])->check(99),'99 exceeds max';
- ok !PositiveRangedInt1([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
+ ok PositiveRangedInt1([min=>10,max=>100])->check(50), '50 in the range';
+ ok !PositiveRangedInt1([min=>50, max=>75])->check(99),'99 exceeds max';
+ ok !PositiveRangedInt1([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
- CHECKRANGEDINT2: {
- eval {
- PositiveRangedInt1([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
- };
-
- like $@,
- qr/Validation failed for 'main::Range'/,
- 'Got Expected Error';
- }
+ CHECKRANGEDINT2: {
+ eval {
+ PositiveRangedInt1([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
+ };
+
+ like $@,
+ qr/Validation failed for 'main::Range'/,
+ 'Got Expected Error';
+ }
- ok !PositiveRangedInt1([min=>-100,max=>100])->check(-10), '-10 is not positive';
+ ok !PositiveRangedInt1([min=>-100,max=>100])->check(-10), '-10 is not positive';
- subtype PositiveInt,
- as Int,
- where {
- my ($value, $range) = @_;
- return $value >= 0;
- };
+ subtype PositiveInt,
+ as Int,
+ where {
+ my ($value, $range) = @_;
+ return $value >= 0;
+ };
- ## subtype Range to re-parameterize Range with subtypes
- subtype PositiveRange,
- as Range[max=>PositiveInt, min=>PositiveInt];
-
- ## create subtype via reparameterizing
- subtype PositiveRangedInt2,
- as RangedInt[PositiveRange];
+ ## subtype Range to re-parameterize Range with subtypes
+ subtype PositiveRange,
+ as Range[max=>PositiveInt, min=>PositiveInt];
+
+ ## create subtype via reparameterizing
+ subtype PositiveRangedInt2,
+ as RangedInt[PositiveRange];
- ok PositiveRangedInt2([min=>10,max=>100])->check(50), '50 in the range';
- ok !PositiveRangedInt2([min=>50, max=>75])->check(99),'99 exceeds max';
- ok !PositiveRangedInt2([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
+ ok PositiveRangedInt2([min=>10,max=>100])->check(50), '50 in the range';
+ ok !PositiveRangedInt2([min=>50, max=>75])->check(99),'99 exceeds max';
+ ok !PositiveRangedInt2([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
- CHECKRANGEDINT2: {
- eval {
- PositiveRangedInt2([min=>-100,max=>100])->check(-10); ## Not OK, not a valid Range!
- };
-
- like $@,
- qr/Validation failed for 'main::PositiveRange'/,
- 'Got Expected Error';
- }
+ CHECKRANGEDINT2: {
+ eval {
+ PositiveRangedInt2([min=>-100,max=>100])->check(-10); ## Not OK, not a valid Range!
+ };
+
+ like $@,
+ qr/Validation failed for 'main::PositiveRange'/,
+ 'Got Expected Error';
+ }
- subtype NameAge,
- as Tuple[Str, Int];
-
- ok NameAge->check(['John',28]), 'Good NameAge';
- ok !NameAge->check(['John','Napiorkowski']), 'Bad NameAge';
-
- subtype NameBetween18and35Age,
- as NameAge[
- Str,
- PositiveRangedInt2[min=>18,max=>35],
- ];
-
- ok NameBetween18and35Age->check(['John',28]), 'Good NameBetween18and35Age';
- ok !NameBetween18and35Age->check(['John','Napiorkowski']), 'Bad NameBetween18and35Age';
- ok !NameBetween18and35Age->check(['John',99]), 'Bad NameBetween18and35Age';
+ subtype NameAge,
+ as Tuple[Str, Int];
+
+ ok NameAge->check(['John',28]), 'Good NameAge';
+ ok !NameAge->check(['John','Napiorkowski']), 'Bad NameAge';
+
+ subtype NameBetween18and35Age,
+ as NameAge[
+ Str,
+ PositiveRangedInt2[min=>18,max=>35],
+ ];
+
+ ok NameBetween18and35Age->check(['John',28]), 'Good NameBetween18and35Age';
+ ok !NameBetween18and35Age->check(['John','Napiorkowski']), 'Bad NameBetween18and35Age';
+ ok !NameBetween18and35Age->check(['John',99]), 'Bad NameBetween18and35Age';
}
use Test::More tests=>15; {
-
- use strict;
- use warnings;
+
+ use strict;
+ use warnings;
- use MooseX::Types::Parameterizable qw(Parameterizable);
- use MooseX::Types::Moose qw(Int Str HashRef ArrayRef);
-
- use MooseX::Types -declare=>[qw(
- InfoHash OlderThanAge DefinedOlderThanAge
- )];
-
- ok subtype( InfoHash,
- as HashRef[Int],
- where {
- defined $_->{older_than};
- }), 'Created InfoHash Set (reduce need to depend on Dict type';
+ use MooseX::Types::Parameterizable qw(Parameterizable);
+ use MooseX::Types::Moose qw(Int Str HashRef ArrayRef);
+
+ use MooseX::Types -declare=>[qw(
+ InfoHash OlderThanAge DefinedOlderThanAge
+ )];
+
+ ok subtype( InfoHash,
+ as HashRef[Int],
+ where {
+ defined $_->{older_than};
+ }), 'Created InfoHash Set (reduce need to depend on Dict type';
- ok InfoHash->check({older_than=>25}), 'Good InfoHash';
- ok !InfoHash->check({older_than=>'aaa'}), 'Bad InfoHash';
- ok !InfoHash->check({at_least=>25}), 'Bad InfoHash';
-
- ok subtype( OlderThanAge,
- as Parameterizable[Int, InfoHash],
- where {
- my ($value, $dict) = @_;
- return $value > $dict->{older_than} ? 1:0;
- }), 'Created the OlderThanAge subtype';
-
- ok OlderThanAge([{older_than=>25}])->check(39), '39 is older than 25';
- ok OlderThanAge([older_than=>1])->check(9), '9 is older than 1';
- ok !OlderThanAge([older_than=>1])->check('aaa'), '"aaa" not an int';
- ok !OlderThanAge([older_than=>10])->check(9), '9 is not older than 10';
-
- coerce OlderThanAge,
- from HashRef,
- via {
- my ($hashref, $constraining_value) = @_;
- return scalar(keys(%$hashref));
- },
- from ArrayRef,
- via {
- my ($arrayref, $constraining_value) = @_;
- #use Data::Dump qw/dump/; warn dump $constraining_value;
- my $age;
- $age += $_ for @$arrayref;
- return $age;
- };
+ ok InfoHash->check({older_than=>25}), 'Good InfoHash';
+ ok !InfoHash->check({older_than=>'aaa'}), 'Bad InfoHash';
+ ok !InfoHash->check({at_least=>25}), 'Bad InfoHash';
+
+ ok subtype( OlderThanAge,
+ as Parameterizable[Int, InfoHash],
+ where {
+ my ($value, $dict) = @_;
+ return $value > $dict->{older_than} ? 1:0;
+ }), 'Created the OlderThanAge subtype';
+
+ ok OlderThanAge([{older_than=>25}])->check(39), '39 is older than 25';
+ ok OlderThanAge([older_than=>1])->check(9), '9 is older than 1';
+ ok !OlderThanAge([older_than=>1])->check('aaa'), '"aaa" not an int';
+ ok !OlderThanAge([older_than=>10])->check(9), '9 is not older than 10';
+
+ coerce OlderThanAge,
+ from HashRef,
+ via {
+ my ($hashref, $constraining_value) = @_;
+ return scalar(keys(%$hashref));
+ },
+ from ArrayRef,
+ via {
+ my ($arrayref, $constraining_value) = @_;
+ #use Data::Dump qw/dump/; warn dump $constraining_value;
+ my $age;
+ $age += $_ for @$arrayref;
+ return $age;
+ };
- is OlderThanAge->name, 'main::OlderThanAge',
- 'Got corect name for OlderThanAge';
- is OlderThanAge([older_than=>5])->coerce([1..10]), 55,
- 'Coerce works';
- is OlderThanAge([older_than=>5])->coerce({a=>1,b=>2,c=>3,d=>4}), 4,
- 'Coerce works';
- like OlderThanAge([older_than=>2])->name, qr/main::OlderThanAge\[/,
- 'Got correct name for OlderThanAge([older_than=>2])';
- is OlderThanAge([older_than=>2])->coerce({a=>5,b=>6,c=>7,d=>8}), 4,
- 'Coerce works';
+ is OlderThanAge->name, 'main::OlderThanAge',
+ 'Got corect name for OlderThanAge';
+ is OlderThanAge([older_than=>5])->coerce([1..10]), 55,
+ 'Coerce works';
+ is OlderThanAge([older_than=>5])->coerce({a=>1,b=>2,c=>3,d=>4}), 4,
+ 'Coerce works';
+ like OlderThanAge([older_than=>2])->name, qr/main::OlderThanAge\[/,
+ 'Got correct name for OlderThanAge([older_than=>2])';
+ is OlderThanAge([older_than=>2])->coerce({a=>5,b=>6,c=>7,d=>8}), 4,
+ 'Coerce works';
- SKIP: {
- skip 'Type Coercions on defined types not supported yet', 1;
+ SKIP: {
+ skip 'Type Coercions on defined types not supported yet', 1;
- subtype DefinedOlderThanAge, as OlderThanAge([older_than=>1]);
-
- coerce DefinedOlderThanAge,
- from ArrayRef,
- via {
- my ($arrayref, $constraining_value) = @_;
- my $age;
- $age += $_ for @$arrayref;
- return $age;
- };
-
- is DefinedOlderThanAge->coerce([1,2,3]), 6, 'Got expected Value';
- }
+ subtype DefinedOlderThanAge, as OlderThanAge([older_than=>1]);
+
+ coerce DefinedOlderThanAge,
+ from ArrayRef,
+ via {
+ my ($arrayref, $constraining_value) = @_;
+ my $age;
+ $age += $_ for @$arrayref;
+ return $age;
+ };
+
+ is DefinedOlderThanAge->coerce([1,2,3]), 6, 'Got expected Value';
+ }
}
projects / gitmo/MooseX-Dependent.git / commitdiff