make class search up type parents work

[gitmo/MooseX-Types.git] / lib / MooseX / Types / TypeDecorator.pm

diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index 2b9398e..fa97bb7 100644 (file)
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -116,7 +116,10 @@ handle $self->isa since AUTOLOAD can't.
 
 =cut
 
-sub isa { shift->_try_delegate('isa', @_) }
+sub isa {
+  return 1 if $_[1]->isa('Moose::Meta::TypeConstraint');
+  shift->_try_delegate('isa', @_)
+}
 
 =head2 can
 
@@ -169,10 +172,24 @@ 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')
-            ? $self->__type_constraint->class
-            : $self->__type_constraint
+        $class
+            ? (
+                $method eq 'new' || $class->can($method)
+                    ? $class
+                    : $tc
+              )
+            : $tc
     );
     $inv->$method(@args);
 }