From: john napiorkowski Date: Thu, 21 May 2009 16:16:53 +0000 (-0400) Subject: got all the tests working again, and basic type tests in place X-Git-Tag: 0.01~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=66efbe23d4f0117101b2673d1baf632388b3e81c;p=gitmo%2FMooseX-Dependent.git got all the tests working again, and basic type tests in place --- diff --git a/lib/MooseX/Dependent/Meta/TypeConstraint/Dependent.pm b/lib/MooseX/Dependent/Meta/TypeConstraint/Dependent.pm index b829ffe..9cfc50f 100644 --- a/lib/MooseX/Dependent/Meta/TypeConstraint/Dependent.pm +++ b/lib/MooseX/Dependent/Meta/TypeConstraint/Dependent.pm @@ -223,6 +223,9 @@ modifier to make sure we get the constraint_generator around 'create_child_type' => sub { my ($create_child_type, $self, %opts) = @_; + if($self->has_constraining_value) { + $opts{constraining_value} = $self->constraining_value; + } return $self->$create_child_type( %opts, parent=> $self, @@ -280,20 +283,24 @@ sub is_a_type_of { around 'check' => sub { my ($check, $self, @args) = @_; - if($self->has_constraining_value) { - push @args, $self->constraining_value; - } return $self->parent_type_constraint->check(@args) && $self->$check(@args) }; around 'validate' => sub { my ($validate, $self, @args) = @_; - if($self->has_constraining_value) { - push @args, $self->constraining_value; - } return $self->parent_type_constraint->validate(@args) || $self->$validate(@args); }; +around '_compiled_type_constraint' => sub { + my ($method, $self, @args) = @_; + my $coderef = $self->$method(@args); + my @extra_args = $self->has_constraining_value ? $self->constraining_value : (); + return sub { + my @local_args = @_; + $coderef->(@local_args, @extra_args); + }; +}; + =head2 get_message Give you a better peek into what's causing the error. diff --git a/lib/MooseX/Dependent/Types.pm b/lib/MooseX/Dependent/Types.pm index b013b5c..371459a 100644 --- a/lib/MooseX/Dependent/Types.pm +++ b/lib/MooseX/Dependent/Types.pm @@ -95,12 +95,12 @@ Or you could have done the following instead (example of re-paramterizing) }; ## subtype Range to re-parameterize Range with subtypes - subtype PositveRange, + subtype PositiveRange, as Range[max=>PositiveInt, min=>PositiveInt]; ## create subtype via reparameterizing subtype PositiveRangedInt, - as RangedInt[PositveRange]; + as RangedInt[PositiveRange]; Notice how re-parameterizing the dependent type 'RangedInt' works slightly differently from re-parameterizing 'PositiveRange'? Although it initially takes diff --git a/t/00-load.t b/t/00-load.t index 062b92b..6166328 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -5,8 +5,8 @@ use Test::More tests=>3; { use warnings; ## List all the modules we want to make sure can at least compile - use_ok 'MooseX::Types::Dependent'; - use_ok 'MooseX::Meta::TypeConstraint::Dependent'; - use_ok 'MooseX::Meta::TypeCoercion::Dependent'; + use_ok 'MooseX::Dependent'; + use_ok 'MooseX::Dependent::Types'; + use_ok 'MooseX::Dependent::Meta::TypeConstraint::Dependent'; } diff --git a/t/01-dependent.t b/t/01-dependent.t index e525c55..90cd1ee 100644 --- a/t/01-dependent.t +++ b/t/01-dependent.t @@ -1,18 +1,19 @@ -use Test::More tests=>53; { +use Test::More tests=>62; { use strict; use warnings; use MooseX::Dependent::Types qw(Dependent); use MooseX::Types::Moose qw(Int Any); - use MooseX::Types -declare=>[qw(SubDependent IntLessThan EvenInt)]; + use MooseX::Types -declare=>[qw(SubDependent IntLessThan EvenInt + LessThan100GreatThen5andEvenIntNot44)]; use Moose::Util::TypeConstraints; ok Dependent->check(1), 'Dependent is basically an "Any"'; - ok !Dependent->validate(1), + is Dependent->validate(1), undef, 'No Error Message'; is Dependent->parent, 'Any', @@ -47,7 +48,7 @@ use Test::More tests=>53; { ok SubDependent->check(1), 'SubDependent is basically an "Any"'; - ok !SubDependent->validate(1), + is SubDependent->validate(1), undef, 'validate returned no error message'; is SubDependent->parent, 'MooseX::Dependent::Types::Dependent', @@ -94,7 +95,7 @@ use Test::More tests=>53; { as Dependent[EvenInt, Int], where { my $value = shift @_; - my $constraining = shift @_ || 200; + my $constraining = shift @_ || 200; #warn "..... $constraining ......"; return ($value < $constraining && $value > 5); }), 'Created IntLessThan subtype'; @@ -178,6 +179,38 @@ use Test::More tests=>53; { 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 ? 0:1; + }), + '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(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(44), + 'is Int, is even, greater than 5, less than 100 BUT 44!'; #die IntLessThan->validate(100); #use Data::Dump qw/dump/; diff --git a/t/02-depending.t b/t/02-depending.t deleted file mode 100644 index 9831139..0000000 --- a/t/02-depending.t +++ /dev/null @@ -1,105 +0,0 @@ -use Test::More tests=>29; { - - use strict; - use warnings; - - use MooseX::Types::Dependent qw(Depending); - use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe); - use MooseX::Types -declare => [qw( - IntGreaterThanInt - UniqueInt - UniqueInt2 - )]; - - ## sugar for alternative syntax: depending {} TC,TC - sub depending(&@) { - my ($coderef, $dependent_tc, $constraining_tc, @args) = @_; - if(@args) { - return (Depending[$dependent_tc,$coderef,$constraining_tc],@args); - } else { - return Depending[$dependent_tc,$coderef,$constraining_tc]; - } - } - - ## The dependent value must exceed the constraining value - subtype IntGreaterThanInt, - as Depending[ - Int, - sub { - my ($dependent_val, $constraining_val) = @_; - return ($dependent_val > $constraining_val) ? 1:undef; - }, - Int, - ]; - - isa_ok IntGreaterThanInt, 'MooseX::Meta::TypeConstraint::Dependent'; - ok !IntGreaterThanInt->check(['a',10]), "Fails, 'a' is not an Int."; - ok !IntGreaterThanInt->check([5,'b']), "Fails, 'b' is not an Int either."; - ok !IntGreaterThanInt->check({4,1}), "Fails, since this isn't an arrayref"; - ok !IntGreaterThanInt->check([5,10]), "Fails, 5 is less than 10"; - ok IntGreaterThanInt->check([11,6]), "Success, 11 is greater than 6."; - ok IntGreaterThanInt->check([12,1]), "Success, 12 is greater than1."; - ok IntGreaterThanInt->check([0,-10]), "Success, 0 is greater than -10."; - - ## The dependent value cannot exist in the constraining arrayref. Also, it - ## (the dependent type) must exceed 2. - subtype UniqueInt, - as Depending[ - Int, - sub { - my ($dependent_int, $constraining_arrayref) = @_; - (grep { $_ == $dependent_int} @$constraining_arrayref) ? undef:1 - }, - ArrayRef[Int], - ], - where { - my ($dependent_val, $constraining_value) = @$_; - return $dependent_val > 2 ? 1:undef; - }; - #message {"Custom Error: $_"}; - - isa_ok UniqueInt, 'MooseX::Meta::TypeConstraint::Dependent'; - ok !UniqueInt->check(['a',[1,2,3]]), '"a" not an Int'; - ok !UniqueInt->check([1,['b','c']]), '"b","c" not an arrayref'; - ok !UniqueInt->check([1,[1,2,3]]), 'not unique in set'; - ok !UniqueInt->check([10,[1,10,15]]), 'not unique in set'; - ok !UniqueInt->check([2,[3..6]]), 'FAIL dependent is too small'; - ok UniqueInt->check([3,[100..110]]), 'PASS unique in set'; - ok UniqueInt->check([4,[100..110]]), 'PASS unique in set'; - - ## Basically as above, with sugar. - subtype UniqueInt2, - as depending { - my ($dependent_int, $constraining_arrayref) = @_; - (grep { $_ == $dependent_int} @$constraining_arrayref) ? undef:1 - } Int, ArrayRef[Int], - where { - my ($dependent_val, $constraining_value) = @$_; - return $dependent_val > 2 ? 1:undef; - }; - - isa_ok UniqueInt2, 'MooseX::Meta::TypeConstraint::Dependent'; - ok !UniqueInt2->check(['a',[1,2,3]]), '"a" not an Int'; - ok !UniqueInt2->check([1,['b','c']]), '"b","c" not an arrayref'; - ok !UniqueInt2->check([1,[1,2,3]]), 'not unique in set'; - ok !UniqueInt2->check([10,[1,10,15]]), 'not unique in set'; - ok !UniqueInt2->check([2,[3..6]]), 'FAIL dependent is too small'; - ok UniqueInt2->check([3,[100..110]]), 'PASS unique in set'; - ok UniqueInt2->check([4,[100..110]]), 'PASS unique in set'; - - ## Basic error messages. TODO should be it's own test - like UniqueInt->validate(['a',[1,2,3]]), qr/failed for 'Int' failed with value a/, - "a is not an Int"; - - like UniqueInt->validate([1,['b','c']]), qr/failed for 'ArrayRef\[Int\]'/, - "ArrayRef doesn't contain Ints"; - - like UniqueInt->validate([1,[1,2,3]]), qr/failed with value \[ 1, \[ 1, 2, 3 \] \]/, - "Is not unique in the constraint"; - - like UniqueInt->validate([10,[1,10,15]]), qr/failed with value \[ 10, \[ 1, 10, 15 \] \]/, - "Expected Error message for [10,[1,10,15]]"; - - like UniqueInt->validate([2,[3..6]]), qr/failed with value \[ 2, \[ 3, 4, 5, 6 \] \]/, - "Expected Error message for [2,[3..6]]"; -} diff --git a/t/03-api.t b/t/03-api.t deleted file mode 100644 index ea84022..0000000 --- a/t/03-api.t +++ /dev/null @@ -1,32 +0,0 @@ -use Test::More tests=>1; { - - use strict; - use warnings; - - use Test::Exception; - use MooseX::Types::Dependent qw(Depending); - use MooseX::Types::Moose qw(Int ArrayRef ); - use MooseX::Types -declare => [qw( - UniqueInt - )]; - - ## sugar for alternative syntax: depending {} TC,TC - sub depending(&@) { - my ($coderef, $dependent_tc, $constraining_tc, @args) = @_; - if(@args) { - return (Depending[$dependent_tc,$coderef,$constraining_tc],@args); - } else { - return Depending[$dependent_tc,$coderef,$constraining_tc]; - } - } - - ok subtype UniqueInt, - as depending { - my ($dependent_int, $constraining_arrayref) = @_; - (grep { $_ == $dependent_int} @$constraining_arrayref) ? undef:1 - } Int, ArrayRef[Int], - where { - my ($dependent_val, $constraining_value) = @$_; - return $dependent_val > 2 ? 1:undef; - }; -}