[Moose-commits] r7874 - in MooseX-Types-Dependent/trunk:
lib/MooseX/Meta/TypeConstraint t
jnapiorkowski at code2.0beta.co.uk
jnapiorkowski at code2.0beta.co.uk
Mon Mar 30 16:53:45 BST 2009
Author: jnapiorkowski
Date: 2009-03-30 08:53:45 -0700 (Mon, 30 Mar 2009)
New Revision: 7874
Modified:
MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm
MooseX-Types-Dependent/trunk/t/02-depending.t
Log:
properly supporting a where clause in the suger example and proof you can customize with the where clause
Modified: MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm
===================================================================
--- MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm 2009-03-30 14:30:26 UTC (rev 7873)
+++ MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm 2009-03-30 15:53:45 UTC (rev 7874)
@@ -237,6 +237,18 @@
);
};
+=head2 constraint
+
+We modify constraint so that the value pass is automatically dereferenced
+
+around 'constraint' => sub {
+ my ($constraint, $self) = @_;
+ return sub {
+ my ($arg) = @_;
+ $self->$constraint->(@$arg);
+ };
+};
+
=head2 is_a_type_of
=head2 is_subtype_of
Modified: MooseX-Types-Dependent/trunk/t/02-depending.t
===================================================================
--- MooseX-Types-Dependent/trunk/t/02-depending.t 2009-03-30 14:30:26 UTC (rev 7873)
+++ MooseX-Types-Dependent/trunk/t/02-depending.t 2009-03-30 15:53:45 UTC (rev 7874)
@@ -1,4 +1,4 @@
-use Test::More tests=>22; {
+use Test::More tests=>23; {
use strict;
use warnings;
@@ -13,9 +13,13 @@
)];
## sugar for alternative syntax: depending {} TC,TC
- sub depending(&$$) {
- my ($coderef, $dependent_tc, $constraining_tc) = @_;
- return Depending[$dependent_tc,$coderef,$constraining_tc];
+ sub depending(&@) {
+ my ($coderef, $dependent_tc, $constraining_tc, @args) = @_;
+ if(@args) {
+ return (Depending[$dependent_tc,$coderef,$constraining_tc], at args);
+ } else {
+ return Depending[$dependent_tc,$coderef,$constraining_tc];
+ }
}
## The dependent value must exceed the constraining value
@@ -64,15 +68,16 @@
(grep { $_ == $dependent_int} @$constraining_arrayref) ? undef:1
} Int, ArrayRef[Int],
where {
- use Data::Dump qw/dump/;
- warn dump @_;
- }
+ 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]]), 'PASS unique in set';
- ok UniqueInt2->check([3,[100..110]]), 'PASS 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';
}
More information about the Moose-commits
mailing list