From: John Napiorkowski <jjnapiork@cpan.org>
Date: Mon, 30 Mar 2009 15:53:45 +0000 (+0000)
Subject: properly supporting a where clause in the suger example and proof you can customize... 
X-Git-Tag: 0.01~39
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1622ae1bffb50ba9e4962752bc1566b911df2383;p=gitmo%2FMooseX-Dependent.git

properly supporting a where clause in the suger example and proof you can customize with the where clause
---

diff --git a/lib/MooseX/Meta/TypeConstraint/Dependent.pm b/lib/MooseX/Meta/TypeConstraint/Dependent.pm
index 83d140c..5219aba 100644
--- a/lib/MooseX/Meta/TypeConstraint/Dependent.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Dependent.pm
@@ -237,6 +237,18 @@ around 'create_child_type' => sub {
     );
 };
 
+=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
diff --git a/t/02-depending.t b/t/02-depending.t
index 99a5b01..6b4ac1a 100644
--- a/t/02-depending.t
+++ b/t/02-depending.t
@@ -1,4 +1,4 @@
-use Test::More tests=>22; {
+use Test::More tests=>23; {
     
     use strict;
     use warnings;
@@ -13,9 +13,13 @@ use Test::More tests=>22; {
     )];
 	
 	## 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],@args);
+		} else {
+			return Depending[$dependent_tc,$coderef,$constraining_tc];
+		}
 	}
     
     ## The dependent value must exceed the constraining value
@@ -64,15 +68,16 @@ use Test::More tests=>22; {
             (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';	
 }