From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 12 Jun 2010 18:35:16 +0000 (-0500)
Subject: don't do metaclass checking/fixing on attributes and methods
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b7c36d233f2fca6337454b2dfbcf2e0179be19fa;p=gitmo%2FClass-MOP.git

don't do metaclass checking/fixing on attributes and methods

attributes and methods are entirely self-contained to the class they're
defined in (unlike the rest of the metaclasses), so inheriting the
default attribute_metaclass and method_metaclass just ends up being
weird action-at-a-distance.
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 4b090d9..06d5939 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -176,8 +176,6 @@ sub update_package_cache_flag {
 ## Metaclass compatibility
 {
     my %base_metaclass = (
-        attribute_metaclass      => 'Class::MOP::Attribute',
-        method_metaclass         => 'Class::MOP::Method',
         wrapped_method_metaclass => 'Class::MOP::Method::Wrapped',
         instance_metaclass       => 'Class::MOP::Instance',
         constructor_class        => 'Class::MOP::Method::Constructor',
diff --git a/t/041_metaclass_incompatibility.t b/t/041_metaclass_incompatibility.t
index c73b01e..53567ae 100644
--- a/t/041_metaclass_incompatibility.t
+++ b/t/041_metaclass_incompatibility.t
@@ -6,13 +6,19 @@ use Test::Exception;
 
 use metaclass;
 
-my %metaclass_attrs = (
+my %checked_metaclass_attrs = (
     'Instance'            => 'instance_metaclass',
-    'Attribute'           => 'attribute_metaclass',
-    'Method'              => 'method_metaclass',
     'Method::Wrapped'     => 'wrapped_method_metaclass',
     'Method::Constructor' => 'constructor_class',
 );
+my %unchecked_metaclass_attrs = (
+    'Attribute'           => 'attribute_metaclass',
+    'Method'              => 'method_metaclass',
+);
+my %metaclass_attrs = (
+    %checked_metaclass_attrs,
+    %unchecked_metaclass_attrs,
+);
 
 # meta classes
 for my $suffix ('Class', keys %metaclass_attrs) {
@@ -65,7 +71,7 @@ throws_ok {
         map { $metaclass_attrs{$_} => "Foo::Meta::$_" } keys %metaclass_attrs,
     )
 } qr/compatible/, 'incompatible Class metaclass';
-for my $suffix (keys %metaclass_attrs) {
+for my $suffix (keys %checked_metaclass_attrs) {
     throws_ok {
         Foo::Meta::Class->create(
             "Foo::All::Sub::$suffix",
@@ -75,6 +81,16 @@ for my $suffix (keys %metaclass_attrs) {
         )
     } qr/compatible/, "incompatible $suffix metaclass";
 }
+for my $suffix (keys %unchecked_metaclass_attrs) {
+    lives_ok {
+        Foo::Meta::Class->create(
+            "Foo::All::Sub::$suffix",
+            superclasses => ['Foo::All'],
+            (map { $metaclass_attrs{$_} => "Foo::Meta::$_" } keys %metaclass_attrs),
+            $metaclass_attrs{$suffix} => "Bar::Meta::$suffix",
+        )
+    } "compatible $suffix metaclass";
+}
 
 # fixing...
 
@@ -105,10 +121,14 @@ for my $suffix (keys %metaclass_attrs) {
             $metaclass_attrs{$suffix} => "Class::MOP::$suffix",
         )
     } "$metaclass_attrs{$suffix} fixing works with other non-default metaclasses";
-    for my $suffix2 (keys %metaclass_attrs) {
+    for my $suffix2 (keys %checked_metaclass_attrs) {
         my $method = $metaclass_attrs{$suffix2};
         isa_ok("Foo::All::Sub::CMOP::$suffix"->meta->$method, "Foo::Meta::$suffix2");
     }
+    for my $suffix2 (keys %unchecked_metaclass_attrs) {
+        my $method = $metaclass_attrs{$suffix2};
+        isa_ok("Foo::All::Sub::CMOP::$suffix"->meta->$method, "Class::MOP::$suffix2");
+    }
 }
 
 # initializing...
@@ -182,7 +202,7 @@ isa_ok(Class::MOP::class_of('Foo::Reverse::Sub::Sub'), 'Foo::Meta::Class');
 {
     Class::MOP::Class->create(
         'Foo::Unsafe',
-        attribute_metaclass => 'Foo::Meta::Attribute',
+        instance_metaclass => 'Foo::Meta::Instance',
     );
     my $meta = Class::MOP::Class->create(
         'Foo::Unsafe::Sub',
@@ -190,7 +210,7 @@ isa_ok(Class::MOP::class_of('Foo::Reverse::Sub::Sub'), 'Foo::Meta::Class');
     $meta->add_attribute(foo => reader => 'foo');
     throws_ok { $meta->superclasses('Foo::Unsafe') }
               qr/compatibility.*pristine/,
-              "can't switch out the attribute metaclass of a class that already has attributes";
+              "can't switch out the metaclass of a class that already has attributes";
 }
 
 # immutability...