Better error message for Foo->meta->clone_instance(not an instance of Foo)

[gitmo/Class-MOP.git] / lib / Class / MOP.pm

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 439ac91..4265ca8 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -16,7 +16,8 @@ use Class::MOP::Method;
 use Class::MOP::Immutable;
 
 BEGIN {
-    our $VERSION   = '0.56';
+    
+    our $VERSION   = '0.63';
     our $AUTHORITY = 'cpan:STEVAN';    
     
     *IS_RUNNING_ON_5_10 = ($] < 5.009_005) 
@@ -34,12 +35,7 @@ BEGIN {
         
     # stash these for a sec, and see how things go
     my $_PP_subname       = sub { $_[1] };
-    my $_PP_get_code_info = sub ($) { 
-        return (            
-            Sub::Identify::stash_name($_[0]), 
-            Sub::Identify::sub_name($_[0])
-        ) 
-    };    
+    my $_PP_get_code_info = \&Sub::Identify::get_code_info;    
     
     if ($ENV{CLASS_MOP_NO_XS}) {
         # NOTE:
@@ -129,6 +125,12 @@ BEGIN {
 
 sub load_class {
     my $class = shift;
+
+    if (ref($class) || !defined($class) || !length($class)) {
+        my $display = defined($class) ? $class : 'undef';
+        confess "Invalid class name ($display)";
+    }
+
     # see if this is already
     # loaded in the symbol table
     return 1 if is_class_loaded($class);
@@ -146,12 +148,39 @@ sub load_class {
 
 sub is_class_loaded {
     my $class = shift;
-    no strict 'refs';
-    return 1 if defined ${"${class}::VERSION"} || defined @{"${class}::ISA"};
-    foreach my $symbol (keys %{"${class}::"}) {
-            next if substr($symbol, -2, 2) eq '::';
-            return 1 if defined &{"${class}::${symbol}"};
+
+    return 0 if ref($class) || !defined($class) || !length($class);
+
+    # walk the symbol table tree to avoid autovififying
+    # \*{${main::}{"Foo::"}} == \*main::Foo::
+
+    my $pack = \*::;
+    foreach my $part (split('::', $class)) {
+        return 0 unless exists ${$$pack}{"${part}::"};
+        $pack = \*{${$$pack}{"${part}::"}};
     }
+
+    # check for $VERSION or @ISA
+    return 1 if exists ${$$pack}{VERSION}
+             && defined *{${$$pack}{VERSION}}{SCALAR};
+    return 1 if exists ${$$pack}{ISA}
+             && defined *{${$$pack}{ISA}}{ARRAY};
+
+    # check for any method
+    foreach ( keys %{$$pack} ) {
+        next if substr($_, -2, 2) eq '::';
+
+        my $glob = ${$$pack}{$_} || next;
+
+        # constant subs
+        if ( IS_RUNNING_ON_5_10 ) {
+            return 1 if ref $glob eq 'SCALAR';
+        }
+
+        return 1 if defined *{$glob}{CODE};
+    }
+
+    # fail
     return 0;
 }
 
@@ -535,7 +564,7 @@ Class::MOP::Method->meta->add_method('wrap' => sub {
     my $code    = shift;
     my %options = @_;
 
-    ('CODE' eq (Scalar::Util::reftype($code) || ''))
+    ('CODE' eq ref($code))
         || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
 
     ($options{package_name} && $options{name})