From: John Napiorkowski <johnn@John-Napiorkowski-MacBook-Pro.local>
Date: Thu, 24 Jun 2010 20:43:58 +0000 (-0400)
Subject: maybe a real fix for coercions?
X-Git-Tag: 0.02~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d8c1bf6b2fb0430a52b5d281f61e3d99872e9b9;p=gitmo%2FMooseX-Dependent.git

maybe a real fix for coercions?
---

diff --git a/lib/MooseX/Meta/TypeConstraint/Parameterizable.pm b/lib/MooseX/Meta/TypeConstraint/Parameterizable.pm
index 9548ae7..5e3e43d 100644
--- a/lib/MooseX/Meta/TypeConstraint/Parameterizable.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Parameterizable.pm
@@ -321,6 +321,19 @@ modify this method so that we pass along the constraining value to the constrain
 coderef and also throw the correct error message if the constraining value does
 not match it's requirement.
 
+around 'compile_type_constraint' => sub {
+    my ($compile_type_constraint, $self, @args) = @_;
+    
+    if($self->has_type_constraints) {
+        my $type_constraints = $self->type_constraints;
+        my $constraint = $self->generate_constraint_for($type_constraints);
+        $self->_set_constraint($constraint);        
+    }
+
+    return $self->$compile_type_constraint(@args);
+};
+
+
 =cut
 
 around '_compiled_type_constraint' => sub {
@@ -348,36 +361,22 @@ More method modification to support dispatch coerce to a parent.
 
 around 'coerce' => sub {
     my ($coerce, $self, @args) = @_;
-    
     if($self->has_constraining_value) {
         push @args, $self->constraining_value;
-        if(@{$self->coercion->type_coercion_map}) {
-            my $coercion = $self->coercion;
-            my $coerced = $self->$coerce(@args);
-            if(defined $coerced) {
-                return $coerced;
-            } else {
-                my $parent = $self->parent;
-                return $parent->coerce(@args); 
-            }
+    }
+    if(@{$self->coercion->type_coercion_map}) {
+        my $coercion = $self->coercion;
+        my $coerced = $coercion->coerce(@args);
+        if(defined $coerced) {
+            return $coerced;
         } else {
             my $parent = $self->parent;
             return $parent->coerce(@args); 
-        } 
-    }
-    else {
-        return $self->$coerce(@args);
-    }
-    return;
-};
-
-=head2 get_message
-
-Give you a better peek into what's causing the error.
-
-around 'get_message' => sub {
-    my ($get_message, $self, $value) = @_;
-    return $self->$get_message($value);
+        }
+    } else {
+        my $parent = $self->parent;
+        return $parent->coerce(@args); 
+    } 
 };
 
 =head1 SEE ALSO
diff --git a/t/05-pod-examples.t b/t/05-pod-examples.t
index c6aca88..0fd80ec 100644
--- a/t/05-pod-examples.t
+++ b/t/05-pod-examples.t
@@ -3,17 +3,12 @@ use warnings;
 
 use Test::More;
 
-eval "use Set::Scalar"; if($@) {
-    plan skip_all => 'Set::Scalar not installed';
-}
-
-
 {
     package Test::MooseX::Types::Parameterizable::Synopsis;
 
     use Moose;
     use MooseX::Types::Parameterizable qw(Parameterizable);
-    use MooseX::Types::Moose qw(Str Int);
+    use MooseX::Types::Moose qw(Str Int ArrayRef);
     use MooseX::Types -declare=>[qw(Varchar)];
 
     ## Create a type constraint that is a string but parameterizes an integer
@@ -28,6 +23,13 @@ eval "use Set::Scalar"; if($@) {
       },
       message { "'$_' is too long"  };
 
+    coerce Varchar,
+      from ArrayRef,
+      via { 
+        my ($arrayref, $int) = @_;
+        join('', @$arrayref);
+      };
+
     my $varchar_five = Varchar[5];
 
     Test::More::ok $varchar_five->check('four');
@@ -38,7 +40,7 @@ eval "use Set::Scalar"; if($@) {
     Test::More::ok $varchar_ten->check( 'X' x 9 );
     Test::More::ok ! $varchar_ten->check( 'X' x 12 );
 
-    has varchar_five => (isa=>Varchar[5], is=>'ro');
+    has varchar_five => (isa=>$varchar_five, is=>'ro', coerce=>1);
     has varchar_ten => (isa=>Varchar[10], is=>'ro');
   
     my $object1 = __PACKAGE__->new(