support isa and coerce together for Moose
Matt S Trout [Mon, 7 May 2012 17:33:38 +0000 (17:33 +0000)]
Changes
lib/Moo/HandleMoose.pm
xt/moo-role-types.t

diff --git a/Changes b/Changes
index d335661..bab87c3 100644 (file)
--- 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
index 3c6b785..f1d9c89 100644 (file)
@@ -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);
     }
index 9dbed24..fb79b78 100644 (file)
@@ -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);
+            }
         }),
     );
 }