X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FTypeDecorator.pm;h=16e4fe0ba71db72e721c127e86907daddf8a8317;hb=7f95d0bf38da072ac2fba35dcfe29abfa62037a3;hp=056eff7195d4e0313d83708c342b4f511bdef81b;hpb=ee3f409392f593290579acf0c12deb24a4fed153;p=gitmo%2FMooseX-Types.git

diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm
index 056eff7..16e4fe0 100644
--- a/lib/MooseX/Types/TypeDecorator.pm
+++ b/lib/MooseX/Types/TypeDecorator.pm
@@ -159,8 +159,9 @@ sub DESTROY {
 
 Delegate to the decorator target, unless this is a class type, in which
 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.
+the class. The method 'new' is special cased to only be permitted on
+the class; if there is no class, or it does not provide a new method,
+an exception will be thrown.
 
 =cut
 
@@ -192,9 +193,15 @@ sub _try_delegate {
     }
         
     my $inv = do {
-      if ($tc->can($method) and $method ne 'new') {
-            $tc
-        } elsif ($class && $class->can($method)) {
+        if ($method eq 'new') {
+            die "new called on type decorator for non-class-type ".$tc->name
+                unless $class;
+            die "new called on class type decorator ".$tc->name."\n"
+                ." for class ${class}\n"
+                ." which does not provide a new method - did you forget to load it?"
+                unless $class->can('new');
+            $class
+        } elsif ($class && !$tc->can($method)) {
             $class
         } else {
             $tc