try again you muppet

diff --git a/Changes b/Changes
index a9cb729..1fc488c 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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') }