From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 7 May 2012 17:33:38 +0000 (+0000)
Subject: support isa and coerce together for Moose
X-Git-Tag: v0.091004~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoo.git;a=commitdiff_plain;h=9dc13bea0bcd6910d704df85dd8287c53200915b

support isa and coerce together for Moose
---

diff --git a/Changes b/Changes
index d335661..bab87c3 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - support isa and coerce together for Moose
   - guard _accessor_maker_for calls in Moo::Role in case Moo isn't loaded
   - reset handlemoose state on mutation in case somebody reified the
     metaclass too early
diff --git a/lib/Moo/HandleMoose.pm b/lib/Moo/HandleMoose.pm
index 3c6b785..f1d9c89 100644
--- a/lib/Moo/HandleMoose.pm
+++ b/lib/Moo/HandleMoose.pm
@@ -75,7 +75,7 @@ sub inject_real_metaclass_for {
       $spec{is} = 'ro' if $spec{is} eq 'lazy' or $spec{is} eq 'rwp';
       delete $spec{asserter};
       if (my $isa = $spec{isa}) {
-        $spec{isa} = do {
+        my $tc = $spec{isa} = do {
           if (my $mapped = $TYPE_MAP{$isa}) {
             $mapped->();
           } else {
@@ -84,7 +84,11 @@ sub inject_real_metaclass_for {
             );
           }
         };
-        die "Aaaargh" if $spec{coerce};
+        if (my $coerce = $spec{coerce}) {
+          $tc->coercion(Moose::Meta::TypeCoercion->new)
+             ->_compiled_type_coercion($coerce);
+          $spec{coerce} = 1;
+        }
       } elsif (my $coerce = $spec{coerce}) {
         my $attr = perlstring($name);
         my $tc = Moose::Meta::TypeConstraint->new(
@@ -93,10 +97,10 @@ sub inject_real_metaclass_for {
                       'my $r = $_[42]{'.$attr.'}; $_[42]{'.$attr.'} = 1; $r'
                    },
                  );
-         $tc->coercion(Moose::Meta::TypeCoercion->new)
-            ->_compiled_type_coercion($coerce);
-         $spec{isa} = $tc;
-         $spec{coerce} = 1;
+        $tc->coercion(Moose::Meta::TypeCoercion->new)
+           ->_compiled_type_coercion($coerce);
+        $spec{isa} = $tc;
+        $spec{coerce} = 1;
       }
       push @attrs, $meta->add_attribute($name => %spec);
     }
diff --git a/xt/moo-role-types.t b/xt/moo-role-types.t
index 9dbed24..fb79b78 100644
--- a/xt/moo-role-types.t
+++ b/xt/moo-role-types.t
@@ -28,14 +28,19 @@ use Test::Fatal;
 
     has output_to => (
         isa => quote_sub(q{
-            use Scalar::Util qw/ blessed /;
-            die $_[0] . "Does not have a ->consume method" unless blessed($_[0]) && $_[0]->can('consume'); }),
+            use Scalar::Util ();
+            die $_[0] . "Does not have a ->consume method" unless Scalar::Util::blessed($_[0]) && $_[0]->can('consume'); }),
         is => 'ro',
         required => 1,
         coerce => quote_sub(q{
-            my %stuff = %{$_[0]};
-            my $class = delete($stuff{class});
-            $class->new(%stuff);
+            use Scalar::Util ();
+            if (Scalar::Util::blessed($_[0]) && $_[0]->can('consume')) {
+              $_[0];
+            } else {
+              my %stuff = %{$_[0]};
+              my $class = delete($stuff{class});
+              $class->new(%stuff);
+            }
         }),
     );
 }