new tests

diff --git a/t/02-types-dependent-extended.t b/t/02-types-dependent-extended.t
new file mode 100644 (file)
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 (file)
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