revert back to code as it was before my depths into madness
Dave Rolsky [Fri, 29 Aug 2008 18:43:22 +0000 (18:43 +0000)]
lib/Moose/Meta/Class.pm
t/050_metaclasses/015_metarole.t

index fc551e8..43b74f6 100644 (file)
@@ -322,8 +322,6 @@ sub _find_next_method_by_name_which_is_not_overridden {
 sub _fix_metaclass_incompatability {
     my ($self, @superclasses) = @_;
 
-    my $self_meta_name = ref($self);
-
     foreach my $super (@superclasses) {
         # don't bother if it does not have a meta.
         my $super_meta = Class::MOP::Class->initialize($super) or next;
@@ -344,126 +342,23 @@ sub _fix_metaclass_incompatability {
             # fixes are needed
             $self->instance_metaclass->isa( $super_meta->instance_metaclass );
 
-        if ( $super_meta->isa($self_meta_name) ) {
-            $self->_require_pristine_to_reinitialize;
-
-            $self = $super_meta->reinitialize(
-                $self->name,
-                attribute_metaclass => $super_meta->attribute_metaclass,
-                method_metaclass    => $super_meta->method_metaclass,
-                instance_metaclass  => $super_meta->instance_metaclass,
-            );
+        next unless $super_meta->isa( ref($self) );
 
-            $self->$_( $super_meta->$_ )
-                for qw( constructor_class destructor_class );
-        }
-        elsif ( __difference_is_roles_only( $self, $super_meta ) ) {
-            $self->_require_pristine_to_reinitialize;
-
-            my @roles = map { $_->name } @{$self->meta->roles};
-
-            $self = $super_meta->reinitialize(
-                $self->name,
-                attribute_metaclass => $super_meta->attribute_metaclass,
-                method_metaclass    => $super_meta->method_metaclass,
-                instance_metaclass  => $super_meta->instance_metaclass,
-            );
-
-            $self = Moose::Util::MetaRole::apply_metaclass_roles(
-                for_class       => $self->name,
-                metaclass_roles => \@roles,
-            );
+        unless ( $self->is_pristine ) {
+            confess "Not reinitializing metaclass for "
+                . $self->name
+                . ", it isn't pristine";
         }
-    }
 
-    return $self;
-}
-
-sub _require_pristine_to_reinitialize {
-    my $self = shift;
-
-    return if $self->is_pristine;
-
-    confess "Not reinitializing metaclass for "
-        . $self->name
-        . ", it isn't pristine";
-}
-
-# This stuff is called as functions because while it operates on
-# metaclasses, it might get a Class::MOP::Class as opposed to a
-# Moose::Meta::Class.
-sub __difference_is_roles_only {
-    my ( $meta1, $meta2 ) = @_;
-
-    return
-        unless $meta1->meta->can('does_role')
-            || $meta2->meta->can('does_role');
-
-    return
-        if __arrays_differ(
-        __methods_excluding_roles( $meta1->meta ),
-        __methods_excluding_roles( $meta2->meta )
-        );
-
-    return
-        if __arrays_differ(
-        __attr_excluding_roles( $meta1->meta ),
-        __attr_excluding_roles( $meta2->meta )
+        $self = $super_meta->reinitialize(
+            $self->name,
+            attribute_metaclass => $super_meta->attribute_metaclass,
+            method_metaclass    => $super_meta->method_metaclass,
+            instance_metaclass  => $super_meta->instance_metaclass,
         );
-
-    return 1;
-}
-
-sub __arrays_differ {
-    my ( $arr1, $arr2 ) = @_;
-
-    my %arr1_vals = map { $_ => 1 } @{$arr1};
-    delete @arr1_vals{ @{$arr2} };
-
-    return keys %arr1_vals ? 1 : 0;
-}
-
-sub __methods_excluding_roles {
-    my $meta = shift;
-
-    my %map = map { $_->name => $_ } $meta->get_all_methods;
-
-    delete $map{meta};
-
-    return values %map unless $meta->can('roles') && $meta->roles;
-
-    for my $role ( @{$meta->roles} ) {
-        for my $role_meth ( values %{$role->get_method_map} ) {
-            next if $role_meth->name eq 'meta';
-
-            my $meta_meth = $map{ $role_meth->name };
-
-            next unless $meta_meth;
-            next unless $meta_meth->body eq $role_meth->body;
-
-            delete $map{ $role_meth->name };
-        }
-
-        for my $attr ( grep { defined } map { $meta->get_attribute($_) } $role->get_attribute_list ) {
-            delete @map{ map { $_->name } @{$attr->associated_methods} };
-        }
-    }
-
-    return [ values %map ];
-}
-
-sub __attr_excluding_roles {
-    my $meta = shift;
-
-    my %map = map { $_->name => $_ } $meta->get_all_attributes;
-
-    return values %map unless $meta->can('roles') && $meta->roles;
-
-    for my $role ( @{$meta->roles} ) {
-        delete @map{ $role->get_attribute_list };
     }
 
-    return [ values %map ];
+    return $self;
 }
 
 # NOTE:
index 4186938..97209a5 100644 (file)
@@ -331,6 +331,12 @@ use Moose::Util::MetaRole;
         q{... and My::Class5->meta() still does Role::Foo} );
 }
 
+SKIP:
+{
+    skip
+        'These tests will fail until Moose::Meta::Class->_fix_metaclass_incompatibility is much smarter.',
+        2;
+
 {
     package My::Class6;
     use Moose;
@@ -349,6 +355,7 @@ use Moose::Util::MetaRole;
     ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
         q{... and My::Class6->meta() does Role::Foo because it extends My::Class} );
 }
+}
 
 # This is the hack needed to work around the
 # _fix_metaclass_incompatibility problem. You must call extends()