make lack of a meta method testable

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

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index b1678a9..15f6801 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -16,7 +16,7 @@ use Devel::GlobalDestruction 'in_global_destruction';
 use Try::Tiny;
 use List::MoreUtils 'all';
 
-our $VERSION   = '1.04';
+our $VERSION   = '1.08';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -280,7 +280,7 @@ sub _check_single_metaclass_compatibility {
               . $self->name . " (" . ($self->$metaclass_type)
               . ")" . " is not compatible with the "
               . "$metaclass_type_name metaclass of its "
-              . "superclass, " . $superclass_name . " ("
+              . "superclass, $superclass_name ("
               . ($super_meta->$metaclass_type) . ")";
     }
 }
@@ -492,6 +492,14 @@ sub create {
 
     # FIXME totally lame
     $meta->add_method('meta' => sub {
+        if (Class::MOP::DEBUG_NO_META()) {
+            my ($self) = @_;
+            if (my $meta = try { $self->SUPER::meta }) {
+                return $meta if $meta->isa('Class::MOP::Class');
+            }
+            confess "'meta' method called by MOP internals"
+                if caller =~ /Class::MOP|metaclass/;
+        }
         $class->initialize(ref($_[0]) || $_[0]);
     });
 
@@ -762,10 +770,13 @@ sub get_all_attributes {
 
 sub superclasses {
     my $self     = shift;
-    my $var_spec = { sigil => '@', type => 'ARRAY', name => 'ISA' };
+
+    my $isa = $self->get_or_add_package_symbol(
+        { sigil => '@', type => 'ARRAY', name => 'ISA' } );
+
     if (@_) {
         my @supers = @_;
-        @{$self->get_package_symbol($var_spec)} = @supers;
+        @{$isa} = @supers;
 
         # NOTE:
         # on 5.8 and below, we need to call
@@ -784,7 +795,8 @@ sub superclasses {
         $self->_check_metaclass_compatibility();
         $self->_superclasses_updated();
     }
-    @{$self->get_package_symbol($var_spec)};
+
+    return @{$isa};
 }
 
 sub _superclasses_updated {