From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 18 May 2012 13:31:46 +0000 (+0000)
Subject: make class search up type parents work
X-Git-Tag: v0.32~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types.git;a=commitdiff_plain;h=cabfc8ede99ead991887b0e6c4285521245e19f2

make class search up type parents work
---

diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index a509a89..fa97bb7 100644
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -172,11 +172,21 @@ sub AUTOLOAD {
 sub _try_delegate {
     my ($self, $method, @args) = @_;
     my $tc = $self->__type_constraint;
+    my $class;
+    my $search_tc = $tc;
+    while ($search_tc->is_subtype_of('Object')) {
+        if ($search_tc->isa('Moose::Meta::TypeConstraint::Class')) {
+            $class = $search_tc->class;
+            last;
+        }
+        $search_tc = $search_tc->parent;
+    }
+        
     my $inv = (
-        $tc->isa('Moose::Meta::TypeConstraint::Class')
+        $class
             ? (
-                $method eq 'new' || $tc->class->can($method)
-                    ? $tc->class
+                $method eq 'new' || $class->can($method)
+                    ? $class
                     : $tc
               )
             : $tc
diff --git a/t/22_class_type.t b/t/22_class_type.t
index 091eba0..5ebfa85 100644
--- a/t/22_class_type.t
+++ b/t/22_class_type.t
@@ -7,7 +7,11 @@ BEGIN {
 
   use MooseX::Types -declare => [ 'ClassyType' ];
 
-  class_type ClassyType, { class => 'ClassyClass' };
+  class_type 'ClassyClass';
+
+  subtype ClassyType, as 'ClassyClass';
+
+  #class_type ClassyType, { class => 'ClassyClass' };
 }
 
 BEGIN {
@@ -33,4 +37,6 @@ is(ref($o->om_nom), 'ClassyClass', 'Attribute happy');
 
 ok(ClassyClassConsumer->new(om_nom => ClassyClass->new), 'Constructor happy');
 
+ok(!eval { ClassyClassConsumer->new(om_nom => 3) }, 'Type checked');
+
 done_testing;