better definition context for native delegation methods

diff --git a/lib/Class/MOP/Method/Generated.pm b/lib/Class/MOP/Method/Generated.pm
index 798720e..f8528bb 100644 (file)
--- a/lib/Class/MOP/Method/Generated.pm
+++ b/lib/Class/MOP/Method/Generated.pm
@@ -23,15 +23,25 @@ sub _generate_description {
     my ( $self, $context ) = @_;
     $context ||= $self->definition_context;
 
-    return "generated method (unknown origin)"
-        unless defined $context;
-
-    if (defined $context->{description}) {
-        return "$context->{description} "
-             . "(defined at $context->{file} line $context->{line})";
-    } else {
-        return "$context->{file} (line $context->{line})";
+    my $desc = "generated method";
+    my $origin = "unknown origin";
+
+    if (defined $context) {
+        if (defined $context->{description}) {
+            $desc = $context->{description};
+        }
+
+        if (defined $context->{file} || defined $context->{line}) {
+            $origin = "defined at "
+                    . (defined $context->{file}
+                        ? $context->{file} : "<unknown file>")
+                    . " line "
+                    . (defined $context->{line}
+                        ? $context->{line} : "<unknown line>");
+        }
     }
+
+    return "$desc ($origin)";
 }
 
 sub _compile_code {

diff --git a/lib/Moose/Meta/Method/Accessor/Native.pm b/lib/Moose/Meta/Method/Accessor/Native.pm
index 3fde0c7..f1ff204 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor/Native.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native.pm
@@ -20,7 +20,16 @@ around new => sub {
         unless $options{curried_arguments}
             && ref($options{curried_arguments}) eq 'ARRAY';
 
-    $options{definition_context} = $options{attribute}->definition_context;
+    my $attr_context = $options{attribute}->definition_context;
+    my $desc = 'native delegation method ';
+    $desc   .= $options{attribute}->associated_class->name;
+    $desc   .= '::' . $options{name};
+    $desc   .= " ($options{delegate_to_method})";
+    $desc   .= " of attribute " . $options{attribute}->name;
+    $options{definition_context} = {
+        %{ $attr_context || {} },
+        description => $desc,
+    };
 
     $options{accessor_type} = 'native';