From: Yuval Kogman <nothingmuch@woobling.org>
Date: Fri, 15 Aug 2008 19:04:12 +0000 (+0000)
Subject: metaclass compatibility checking/fixing corrections
X-Git-Tag: 0_55_01~14
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=50d5df60e3b6a8868dca50319b5c8c9926fe6414;p=gitmo%2FMoose.git

metaclass compatibility checking/fixing corrections
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index b696e19..1437282 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -53,7 +53,7 @@ sub extends {
     # this checks the metaclass to make sure
     # it is correct, sometimes it can get out
     # of sync when the classes are being built
-    my $meta = Class::MOP::Class->initialize($class)->_fix_metaclass_incompatability(@supers);
+    my $meta = Moose::Meta::Class->initialize($class)->_fix_metaclass_incompatability(@supers);
     $meta->superclasses(@supers);
 }
 
@@ -162,27 +162,63 @@ sub init_meta {
         unless find_type_constraint($class);
 
     my $meta;
+
+    if ( $meta = Class::MOP::get_metaclass_by_name($class) ) {
+        unless ( $meta->isa("Moose::Meta::Class") ) {
+            confess "$class already has a metaclass, but it does not inherit $metaclass ($meta)";
+        }
+    } else {
+        # no metaclass, no 'meta' method
+
+        # now we check whether our ancestors have metaclass, and if so borrow that
+        my ( undef, @isa ) = @{ $class->mro::get_linear_isa };
+
+        foreach my $ancestor ( @isa ) {
+            my $ancestor_meta = Class::MOP::get_metaclass_by_name($ancestor) || next;
+
+            my $ancestor_meta_class = ($ancestor_meta->is_immutable
+                ? $ancestor_meta->get_mutable_metaclass_name
+                : ref($ancestor_meta));
+
+            # if we have an ancestor metaclass that inherits $metaclass, we use
+            # that. This is like _fix_metaclass_incompatability, but we can do it now.
+
+            # the case of having an ancestry is not very common, but arises in
+            # e.g. Reaction
+            unless ( $metaclass->isa( $ancestor_meta_class ) ) {
+                if ( $ancestor_meta_class->isa($metaclass) ) {
+                    $metaclass = $ancestor_meta_class;
+                }
+            }
+        }
+
+        $meta = $metaclass->initialize($class);
+    }
+
     if ( $class->can('meta') ) {
+        # check 'meta' method
+
+        # it may be inherited
+
         # NOTE:
         # this is the case where the metaclass pragma
         # was used before the 'use Moose' statement to
         # override a specific class
-        $meta = Class::MOP::Class->initialize($class);
-        ( blessed($meta) && $meta->isa('Moose::Meta::Class') )
-          || confess "$class already has a &meta function, but it does not return a Moose::Meta::Class ($meta)";
+        my $method_meta = $class->meta;
+
+        ( blessed($method_meta) && $method_meta->isa('Moose::Meta::Class') )
+            || confess "$class already has a &meta function, but it does not return a Moose::Meta::Class ($meta)";
+
+        $meta = $method_meta;
     }
-    else {
-        # NOTE:
-        # this is broken currently, we actually need
-        # to allow the possiblity of an inherited
-        # meta, which will not be visible until the
-        # user 'extends' first. This needs to have
-        # more intelligence to it
-        $meta = $metaclass->initialize($class);
+
+    unless ( $meta->has_method("meta") ) { # don't overwrite
+        # also check for inherited non moose 'meta' method?
+        # FIXME also skip this if the user requested by passing an option
         $meta->add_method(
             'meta' => sub {
                 # re-initialize so it inherits properly
-                $metaclass->initialize( blessed( $_[0] ) || $_[0] );
+                $metaclass->initialize( ref($_[0]) || $_[0] );
             }
         );
     }
@@ -191,7 +227,6 @@ sub init_meta {
     $meta->superclasses($base_class)
       unless $meta->superclasses();
 
-
     return $meta;
 }
 
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 40269fb..7bc24ff 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -303,7 +303,12 @@ sub _fix_metaclass_incompatability {
             # and see if our instance metaclass is incompatible
             $self->instance_metaclass->isa($meta->instance_metaclass)
         ) {
-            if ( ref($self) eq 'Moose::Meta::Class' ) { # FIXME better check for vanilla case (check for no attrs, no custom meta, etc etc)
+            if ( $meta->isa(ref($self)) ) {
+                unless ( $self->is_pristine ) {
+                    confess "Not reinitializing metaclass for " . $self->name . ", it isn't pristine";
+                }
+                # also check values %{ $self->get_method_map } for any generated methods
+
                 # NOTE:
                 # We might want to consider actually
                 # transfering any attributes from the
diff --git a/t/050_metaclasses/003_moose_w_metaclass.t b/t/050_metaclasses/003_moose_w_metaclass.t
index cdf3034..55576ba 100644
--- a/t/050_metaclasses/003_moose_w_metaclass.t
+++ b/t/050_metaclasses/003_moose_w_metaclass.t
@@ -51,6 +51,6 @@ isa_ok(Foo->meta, 'Foo::Meta');
     eval 'use Moose;';
     ::ok($@, '... could not load moose without correct metaclass');
     ::like($@, 
-        qr/^Bar already has a \&meta function\, but it does not return a Moose\:\:Meta\:\:Class/, 
+        qr/^Bar already has a metaclass, but it does not inherit Moose::Meta::Class/,
         '... got the right error too');
 }