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,
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.
-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',
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',
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';
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/;
+++ /dev/null
-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]]";
-}
projects / gitmo/MooseX-Dependent.git / commitdiff