From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 18 May 2012 20:35:38 +0000 (+0000)
Subject: try again you muppet
X-Git-Tag: v0.33~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types.git;a=commitdiff_plain;h=ee3f409392f593290579acf0c12deb24a4fed153

try again you muppet
---

diff --git a/Changes b/Changes
index a9cb729..1fc488c 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,8 @@ Revision history for MooseX-Types
 
 {{$NEXT}}
 
+        - Switch delegation order to prioritise type over class except for new
+
 0.32    2012-05-18
 
         - Support delegation of methods to the class for class types
diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index febb46a..056eff7 100644
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -158,8 +158,9 @@ sub DESTROY {
 =head2 AUTOLOAD
 
 Delegate to the decorator target, unless this is a class type, in which
-case it will call the class' version of the method if present, and fall
-back to the type's version if not.
+case it will try to delegate to the type object, then if that fails try
+the class. The method 'new' is special cased to go to the class first
+if present.
 
 =cut
 
@@ -190,7 +191,15 @@ sub _try_delegate {
         }
     }
         
-    my $inv = ($class && $class->can($method)) ? $class : $tc;
+    my $inv = do {
+      if ($tc->can($method) and $method ne 'new') {
+            $tc
+        } elsif ($class && $class->can($method)) {
+            $class
+        } else {
+            $tc
+        }
+    };
 
     $inv->$method(@args);
 }
diff --git a/t/22_class_type.t b/t/22_class_type.t
index 5ebfa85..fe90fac 100644
--- a/t/22_class_type.t
+++ b/t/22_class_type.t
@@ -20,6 +20,8 @@ BEGIN {
 
   use Moose;
 
+  sub check { die "FAIL" }
+
   package ClassyClassConsumer;
 
   BEGIN { MyTypes->import('ClassyType') }