[Moose-commits] r7874 - in MooseX-Types-Dependent/trunk: lib/MooseX/Meta/TypeConstraint t

[jnapiorkowski at code2.0beta.co.uk]

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';	
 }