From: John Napiorkowski Date: Wed, 23 Jun 2010 23:39:51 +0000 (-0400) Subject: more tabs to spaces X-Git-Tag: 0.02~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Dependent.git;a=commitdiff_plain;h=d1cfb0438ab08c82be373f613ecaf6c2d175d4e8 more tabs to spaces --- diff --git a/Changes b/Changes index a4db916..3cfe1e2 100644 --- a/Changes +++ b/Changes @@ -2,5 +2,5 @@ Revision history for MooseX-Types-Parameterized 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 :) diff --git a/lib/MooseX/Types/Parameterizable.pm b/lib/MooseX/Types/Parameterizable.pm index c28a086..c5dbc44 100644 --- a/lib/MooseX/Types/Parameterizable.pm +++ b/lib/MooseX/Types/Parameterizable.pm @@ -20,7 +20,7 @@ Within your L declared library module: use MooseX::Types::Parameterizable qw(Parameterizable); subtype Set, - as class_type("Set::Scalar"); + as class_type("Set::Scalar"); subtype UniqueInt, as Parameterizable[Int, Set], @@ -28,14 +28,14 @@ Within your L declared library module: 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]; @@ -52,7 +52,7 @@ Within your L declared library module: my $negative_set = Set::Scalar->new(-1,-2,-3); UniqueInt([$negative_set])->check(100); ## Throws exception - + =head1 DESCRIPTION A L library for creating parameterizable types. A parameterizable type @@ -65,20 +65,20 @@ set of numbers within which another number must be unique, or allowable ranges 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 @@ -92,9 +92,9 @@ values first, as in: 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 @@ -125,38 +125,38 @@ required type parameter type constraint, or if re-parameterizing, the new 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 @@ -168,14 +168,14 @@ constraint of 'RangedInt' would have a parent of 'Int', not 'Parameterizable' an 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 since that would require the @@ -195,8 +195,8 @@ create a Parameterizable type like: 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: @@ -233,18 +233,18 @@ it is available to the constraint. ## 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 @@ -270,7 +270,7 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( MooseX::Meta::TypeConstraint::Parameterizable->new( name => 'MooseX::Types::Parameterizable::Parameterizable', parent => find_type_constraint('Any'), - constraint => sub {1}, + constraint => sub {1}, ) ); diff --git a/t/01-types-parameterizable.t b/t/01-types-parameterizable.t index fa9c0cc..c1bf2f6 100644 --- a/t/01-types-parameterizable.t +++ b/t/01-types-parameterizable.t @@ -1,280 +1,280 @@ 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'; + } } diff --git a/t/02-types-parameterizable-extended.t b/t/02-types-parameterizable-extended.t index 061dba5..6a5c8af 100644 --- a/t/02-types-parameterizable-extended.t +++ b/t/02-types-parameterizable-extended.t @@ -1,45 +1,45 @@ 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"; @@ -47,126 +47,126 @@ use Test::More; { 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'; } diff --git a/t/03-coercions.t b/t/03-coercions.t index 1e105be..42657ee 100644 --- a/t/03-coercions.t +++ b/t/03-coercions.t @@ -1,78 +1,78 @@ 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'; + } }