More metaclass compatibility handling.

When creating a new class, fix its metaclass compatibility as well as
when extends is called. This means that classes created via
Moose::Util::MetaRole (aka new metaclasses) have their metaclass
compatibility fixed. Sounds crazy, but it basically lets combine
modules which give the caller a new metaclass (like Fey::ORM::Table)
and modules which then apply roles to the caller's metaclass (like
MX::ClassAttribute).

And hey, there's tests.

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 20e9b85..321e3ad 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -63,9 +63,16 @@ sub create {
     (ref $options{roles} eq 'ARRAY')
         || $self->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
             if exists $options{roles};
-    
+
+    my $super = delete $options{superclasses};
+
     my $class = $self->SUPER::create($package_name, %options);
-    
+
+    if ( my @super = @{ $super || [] } ) {
+        $class = $class->_fix_metaclass_incompatibility(@super);
+        $class->superclasses(@super);
+    }
+
     if (exists $options{roles}) {
         Moose::Util::apply_all_roles($class, @{$options{roles}});
     }
@@ -352,7 +359,7 @@ sub _reconcile_with_superclass_meta {
 
     my $super_meta = $super->meta;
 
-    my $super_metaclass_name
+    my $super_meta_name
         = $super_meta->is_immutable
         ? $super_meta->get_mutable_metaclass_name
         : ref($super_meta);
@@ -361,7 +368,7 @@ sub _reconcile_with_superclass_meta {
 
     # If neither of these is true we have a more serious
     # incompatibility that we just cannot fix (yet?).
-    if ( $super_metaclass_name->isa( ref $self )
+    if ( $super_meta_name->isa( ref $self )
         && all { $super_meta->$_->isa( $self->$_ ) } @MetaClassTypes ) {
         return $self->_reinitialize_with($super_meta);
     }

diff --git a/t/050_metaclasses/015_metarole.t b/t/050_metaclasses/015_metarole.t
index 0df8d4d..4928b5b 100644 (file)
--- a/t/050_metaclasses/015_metarole.t
+++ b/t/050_metaclasses/015_metarole.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 66;
+use Test::More tests => 68;
 
 use Moose::Util::MetaRole;
 
@@ -391,3 +391,54 @@ use Moose::Util::MetaRole;
     ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
         q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} );
 }
+
+# This tests applying meta roles to a metaclass's metaclass. This is
+# completely insane, but is exactly what happens with
+# Fey::Meta::Class::Table. It's a subclass of Moose::Meta::Class
+# itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass
+# for Fey::Meta::Class::Table does a role.
+#
+# At one point this caused a metaclass incompatibility error down
+# below, when we applied roles to the metaclass of My::Class10. It's
+# all madness but as long as the tests pass we're happy.
+{
+    package My::Meta::Class2;
+    use Moose;
+    extends 'Moose::Meta::Class';
+
+    Moose::Util::MetaRole::apply_metaclass_roles(
+        for_class       => 'My::Meta::Class2',
+        metaclass_roles => ['Role::Foo'],
+    );
+}
+
+{
+    package My::Meta2;
+
+    use Moose::Exporter;
+    Moose::Exporter->setup_import_methods( also => 'Moose' );
+
+    sub init_meta {
+        shift;
+        my %p = @_;
+
+        Moose->init_meta( %p, metaclass => 'My::Meta::Class2' );
+    }
+}
+
+{
+    package My::Class10;
+    My::Meta2->import;
+
+    Moose::Util::MetaRole::apply_metaclass_roles(
+        for_class       => 'My::Class10',
+        metaclass_roles => ['Role::Bar'],
+    );
+}
+
+{
+    ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'),
+        q{My::Class10->meta()->meta() does Role::Foo } );
+    ok( My::Class10->meta()->isa('My::Meta::Class2'),
+        q{... and My::Class10->meta still isa(My::Meta::Class2)} );
+}