From: john napiorkowski Date: Fri, 22 May 2009 16:46:23 +0000 (-0400) Subject: new tests X-Git-Tag: 0.01~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=54f0d8d6fe1876ce84532c9e6d790cd288eaad72;p=gitmo%2FMooseX-Dependent.git new tests --- diff --git a/t/02-types-dependent-extended.t b/t/02-types-dependent-extended.t new file mode 100644 index 0000000..78ea8e1 --- /dev/null +++ b/t/02-types-dependent-extended.t @@ -0,0 +1,172 @@ + +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 MooseX::Types::Structured qw(Tuple Dict slurpy); + use MooseX::Dependent::Types qw(Dependent); + 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 Dependent[Int, Set], + where { + my ($int, $set) = @_; + return !$set->has($int); + }), 'Created UniqueInt Dependent 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(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}; + }; + + subtype RangedInt, + as Dependent[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'; + } + + 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'; + } + + 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'; + + 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'; + + 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]; + + 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'; + } + + 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'; +} \ No newline at end of file diff --git a/t/03-coercions.t b/t/03-coercions.t new file mode 100644 index 0000000..3743b80 --- /dev/null +++ b/t/03-coercions.t @@ -0,0 +1,46 @@ + +use Test::More tests=>9; { + + use strict; + use warnings; + + use MooseX::Dependent::Types qw(Dependent); + use MooseX::Types::Moose qw(Int Str HashRef ArrayRef); + + use MooseX::Types -declare=>[qw( + InfoHash OlderThanAge + )]; + + 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 Dependent[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 ArrayRef, + via { + my ($arrayref, $constraining_value) = @_; + my $age; + $age += $_ for @$arrayref; + return $age; + }; + + #warn OlderThanAge([older_than=>1])->coerce([1,2,3,4]); +} \ No newline at end of file