fix setting associated_metaclass and attribute on accessor objects
Jesse Luehrs [Mon, 25 Apr 2011 15:38:05 +0000 (10:38 -0500)]
lib/Class/MOP/Attribute.pm
lib/Moose.pm
lib/Moose/Meta/Method/Accessor.pm

index d16d66f..305ff1b 100644 (file)
@@ -366,8 +366,10 @@ sub _process_accessors {
         my ($name, $method) = %{$accessor};
         $method = $self->accessor_metaclass->wrap(
             $method,
+            attribute    => $self,
             package_name => $self->associated_class->name,
             name         => $name,
+            associated_metaclass => $self->associated_class,
             definition_context => $method_ctx,
         );
         $self->associate_method($method);
@@ -392,6 +394,7 @@ sub _process_accessors {
                 accessor_type => $type,
                 package_name  => $self->associated_class->name,
                 name          => $accessor,
+                associated_metaclass => $self->associated_class,
                 definition_context => $method_ctx,
             );
         }
index 65538a7..df95790 100644 (file)
@@ -246,7 +246,6 @@ $_->make_immutable(
     Moose::Meta::TypeCoercion::Union
 
     Moose::Meta::Method
-    Moose::Meta::Method::Accessor
     Moose::Meta::Method::Constructor
     Moose::Meta::Method::Destructor
     Moose::Meta::Method::Overridden
@@ -267,9 +266,17 @@ $_->make_immutable(
     Moose::Meta::Role::Application::ToInstance
 );
 
-Moose::Meta::Mixin::AttributeCore->meta->make_immutable(
+$_->make_immutable(
     inline_constructor => 0,
     constructor_name   => undef,
+    # these are Class::MOP accessors, so they need inlining
+    inline_accessors => 1
+    ) for grep { $_->is_mutable }
+    map { $_->meta }
+    qw(
+    Moose::Meta::Method::Accessor
+    Moose::Meta::Method::Delegation
+    Moose::Meta::Mixin::AttributeCore
 );
 
 1;
index 6ee2873..a412b53 100644 (file)
@@ -9,6 +9,15 @@ use Try::Tiny;
 use base 'Moose::Meta::Method',
          'Class::MOP::Method::Accessor';
 
+# multiple inheritance is terrible
+sub new {
+    goto &Class::MOP::Method::Accessor::new;
+}
+
+sub _new {
+    goto &Class::MOP::Method::Accessor::_new;
+}
+
 sub _error_thrower {
     my $self = shift;
     return $self->associated_attribute