From: Jesse Luehrs <doy@tozt.net>
Date: Wed, 15 Jun 2011 23:12:19 +0000 (-0500)
Subject: better accessor context descriptions in general
X-Git-Tag: 2.0102~18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0ea503fa819cc70842f4bb8af7a6abf8b65f006b;hp=4e2f0ea7e2b3f484a307af9413c92900f3d66a1a;p=gitmo%2FMoose.git

better accessor context descriptions in general
---

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 305ff1b..309eadb 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -354,16 +354,15 @@ sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
 sub _process_accessors {
     my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
 
-    my $method_ctx;
-
-    if ( my $ctx = $self->definition_context ) {
-        $method_ctx = { %$ctx };
-    }
+    my $method_ctx = { %{ $self->definition_context || {} } };
 
     if (ref($accessor)) {
         (ref($accessor) eq 'HASH')
             || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
         my ($name, $method) = %{$accessor};
+
+        $method_ctx->{description} = $self->_accessor_description($name, $type);
+
         $method = $self->accessor_metaclass->wrap(
             $method,
             attribute    => $self,
@@ -379,14 +378,7 @@ sub _process_accessors {
         my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
         my $method;
         try {
-            if ( $method_ctx ) {
-                my $desc = "accessor " . $self->associated_class->name . "::$accessor";
-                if ( $accessor ne $self->name ) {
-                    $desc .= " of attribute " . $self->name;
-                }
-
-                $method_ctx->{description} = $desc;
-            }
+            $method_ctx->{description} = $self->_accessor_description($accessor, $type);
 
             $method = $self->accessor_metaclass->new(
                 attribute     => $self,
@@ -406,6 +398,18 @@ sub _process_accessors {
     }
 }
 
+sub _accessor_description {
+    my $self = shift;
+    my ($name, $type) = @_;
+
+    my $desc = "$type " . $self->associated_class->name . "::$name";
+    if ( $name ne $self->name ) {
+        $desc .= " of attribute " . $self->name;
+    }
+
+    return $desc;
+}
+
 sub install_accessors {
     my $self   = shift;
     my $inline = shift;
diff --git a/t/cmop/attribute_introspection.t b/t/cmop/attribute_introspection.t
index 6a9bb21..86d0c57 100644
--- a/t/cmop/attribute_introspection.t
+++ b/t/cmop/attribute_introspection.t
@@ -60,6 +60,7 @@ use Class::MOP;
 
         process_accessors
         _process_accessors
+        _accessor_description
         install_accessors
         remove_accessors