From: Tomas Doran (t0m) <t0m@state51.co.uk>
Date: Thu, 7 May 2009 00:07:25 +0000 (+0100)
Subject: Fix one of the issues you see with metaclass incomat when you have a moose-non moose... 
X-Git-Tag: 0.78~22
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=349cda54dc7757032705b5485612b7cedfa2e2d5;p=gitmo%2FMoose.git

Fix one of the issues you see with metaclass incomat when you have a moose-non moose-moose @ISA chain. Specifically, this affects Catalyst applications if you want to run 5.80, have a Moose native application, but extend a controller base class from CPAN which hasn't been ported to Moose yet. This also changes a few private methods to pass the metaclass instance, rather than the class name - as we now have it sooner ergo it's neater.
---

diff --git a/Changes b/Changes
index 10b2191..9cadfa7 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,10 @@
 Also see Moose::Manual::Delta for more details of, and workarounds
 for, noteworthy changes.
 
+    * Moose::Meta::Class
+      - Fix metaclass incompatibility errors when extending a vanilla perl
+        class which isa Moose class with a metaclass role applied (t0m)
+
 0.78
     * Moose::Cookbook::FAQ and Moose::Cookbook::WTF
       - Merged these documents into what is now Moose::Manual::FAQ
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 09a0d33..b1c642d 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -8,7 +8,7 @@ use Class::MOP;
 
 use Carp ();
 use List::Util qw( first );
-use List::MoreUtils qw( any all uniq );
+use List::MoreUtils qw( any all uniq first_index );
 use Scalar::Util 'weaken', 'blessed';
 
 our $VERSION   = '0.77';
@@ -305,24 +305,44 @@ sub _fix_metaclass_incompatibility {
     my ($self, @superclasses) = @_;
 
     foreach my $super (@superclasses) {
-        next if $self->_superclass_meta_is_compatible($super);
-
-        unless ( $self->is_pristine ) {
-            $self->throw_error(
-                      "Cannot attempt to reinitialize metaclass for "
-                    . $self->name
-                    . ", it isn't pristine" );
+        my $meta = Class::MOP::Class->initialize($super);
+
+        my @all_supers = $meta->linearized_isa;
+        shift(@all_supers); # Discard self
+        my @super_metas_to_fix = ( $meta );
+
+        # We need to check&fix the imediate superclass, and if its @ISA contains
+        # a class without a metaclass instance, followed by a class with a
+        # metaclass instance, init a metaclass instance for classes without
+        # one and fix compat up to and including the class which was already
+        # initialized.
+        my $idx = first_index { Class::MOP::class_of($_) } @all_supers;
+        push(@super_metas_to_fix,
+            map { Class::MOP::Class->initialize($_) } @all_supers[0..$idx]
+        ) if ($idx >= 0);
+
+        foreach my $super_meta (@super_metas_to_fix) {
+            $self->_fix_one_incompatible_metaclass($super_meta);
         }
+    }
+}
+
+sub _fix_one_incompatible_metaclass {
+    my ($self, $meta) = @_;
+
+    return if $self->_superclass_meta_is_compatible($meta);
 
-        $self->_reconcile_with_superclass_meta($super);
+    unless ( $self->is_pristine ) {
+        $self->throw_error(
+              "Cannot attempt to reinitialize metaclass for "
+            . $self->name
+            . ", it isn't pristine" );
     }
+    $self->_reconcile_with_superclass_meta($meta);
 }
 
 sub _superclass_meta_is_compatible {
-    my ($self, $super) = @_;
-
-    my $super_meta = Class::MOP::Class->initialize($super)
-        or return 1;
+    my ($self, $super_meta) = @_;
 
     next unless $super_meta->isa("Class::MOP::Class");
 
@@ -348,9 +368,7 @@ my @MetaClassTypes =
         error_class );
 
 sub _reconcile_with_superclass_meta {
-    my ($self, $super) = @_;
-
-    my $super_meta = Class::MOP::class_of($super);
+    my ($self, $super_meta) = @_;
 
     my $super_meta_name
         = $super_meta->is_immutable
diff --git a/t/600_todo_tests/008_moose_nonmoose_moose_chain_extends.t b/t/060_compat/004_extends_nonmoose_that_isa_moose_with_metarole.t
similarity index 59%
rename from t/600_todo_tests/008_moose_nonmoose_moose_chain_extends.t
rename to t/060_compat/004_extends_nonmoose_that_isa_moose_with_metarole.t
index 8f0b62d..c37ebc4 100644
--- a/t/600_todo_tests/008_moose_nonmoose_moose_chain_extends.t
+++ b/t/060_compat/004_extends_nonmoose_that_isa_moose_with_metarole.t
@@ -19,11 +19,8 @@ use Test::More tests => 1;
     use Moose;
     use Test::More;
     use Test::Exception;
-    TODO: {
-        local $TODO = 'Metaclass incompatibility';
-        lives_ok {
-            extends 'SubClassUseBase';
-        } 'Can extend non-moose class whos parent class is a Moose class with a meta role';
-    }
+    lives_ok {
+        extends 'SubClassUseBase';
+    } 'Can extend non-moose class whos parent class is a Moose class with a meta role';
 }