Make error messages for setting with a reader more awesome

Changes

@@ -3,6 +3,14 @@ for, noteworthy changes.
 
 {{$NEXT}}
 
+  [ENHANCEMENTS]
+
+  - When attempting to erroneously set an attribute with a read-only accessor
+    the Moose::Exception::CannotAssignValueToReadOnlyAccessor error raised now
+    is more informative if a writer accessor exists, suggesting that that writer
+    be used and supplying the name of the writer if it is non private (i.e.
+    doesn't start with an underscore).
+
 2.1500   2015-06-30 (TRIAL RELEASE)
 
   [ENHANCEMENTS]

lib/Class/MOP/Method/Accessor.pm

@@ -132,10 +132,14 @@ sub _generate_reader_method {
     my $attr = $self->associated_attribute;
     my $class = $attr->associated_class;
 
+    my @suggested_writer;
+    @suggested_writer = (suggested_writer => $attr->writer) if $attr->has_writer;
+
     return sub {
         $self->_throw_exception( CannotAssignValueToReadOnlyAccessor => class_name => $class->name,
                                                                 value      => $_[1],
-                                                                attribute  => $attr
+                                                                attribute  => $attr,
+                                                                @suggested_writer
                        )
             if @_ > 1;
         $attr->get_value($_[0]);
@@ -147,14 +151,18 @@ sub _generate_reader_method_inline {
     my $attr = $self->associated_attribute;
     my $attr_name = $attr->name;
 
+    my $writer_string = '';
+    $writer_string = "suggested_writer => '" . $attr->writer . "'" if $attr->has_writer;
+
     return try {
         $self->_compile_code([
             'sub {',
                 'if (@_ > 1) {',
                     $self->_inline_throw_exception( CannotAssignValueToReadOnlyAccessor =>
                                                     'class_name                          => ref $_[0],'.
                                                     'value                               => $_[1],'.
-                                                    "attribute_name                      => '".$attr_name."'",
+                                                    "attribute_name                      => '".$attr_name."',".
+                                                    $writer_string
                     ) . ';',
                 '}',
                 $attr->_inline_get_value('$_[0]'),

lib/Moose/Exception/CannotAssignValueToReadOnlyAccessor.pm

@@ -1,5 +1,5 @@
 package Moose::Exception::CannotAssignValueToReadOnlyAccessor;
-our $VERSION = '2.1501'; # TRIAL
+our $VERSION = '2.1501';
 
 use Moose;
 extends 'Moose::Exception';
@@ -11,9 +11,20 @@ has 'value' => (
     required => 1
 );
 
+has 'suggested_writer' => (
+    is        => 'ro',
+    isa       => 'Str',
+    predicate => 'has_suggested_writer',
+);
+
+my $MESSAGE = "Cannot assign a value to a read-only accessor";
+
 sub _build_message {
     my $self = shift;
-    "Cannot assign a value to a read-only accessor";
+    return $MESSAGE unless $self->has_suggested_writer;
+    return "$MESSAGE (did you mean to call the private writer?)"
+        if $self->suggested_writer =~ /\A_/;
+    return "$MESSAGE (did you mean to call the '".$self->suggested_writer."' writer?)";
 }
 
 1;

t/exceptions/class-mop-method-accessor.t

@@ -2,6 +2,7 @@ use strict;
 use warnings;
 
 use Test::More;
+use Test::Moose;
 use Test::Fatal;
 
 use Moose();
@@ -276,4 +277,104 @@ use Moose();
         120,
         "x is read only");
 }
+
+# we need to test both with and without moose to get full test coverage
+# so we can test both the inlined and non inlined version of the generated
+# accessor.  This is because Moose always uses the inlined accessor code
+
+{
+    {
+        package CupOfTea;
+        use metaclass;
+
+        CupOfTea->meta->add_attribute('sugars' => (
+            reader   => 'sugars',
+            writer   => 'set_sugars',
+            init_arg => 'sugars'
+        ));
+
+        CupOfTea->meta->add_attribute('milk' => (
+            reader   => 'milk',
+            writer   => '_set_milk',
+            init_arg => 'milk'
+        ));
+
+        sub new {
+            my $class = shift;
+            bless $class->meta->new_object(@_) => $class;
+        }
+    }
+
+    my $cup = CupOfTea->new();
+    _test_sugars($cup);
+    _test_milk($cup);
+}
+
+{
+    {
+        package CupOfCoffee;
+        use Moose;
+
+        has 'sugars' => (
+            is       => 'rw',
+            writer   => 'set_sugars',
+        );
+
+        has 'milk' => (
+            is       => 'rw',
+            writer   => '_set_milk',
+        );
+    }
+
+    my $cup = CupOfCoffee->new();
+    _test_sugars($cup);
+    _test_milk($cup);
+}
+
+sub _test_sugars {
+    my $cup = shift;
+
+    my $exception = exception { $cup->sugars(2) };
+    _test_cup_exception($exception, "sugars", ref($cup), "'set_sugars'");
+}
+
+sub _test_milk {
+    my $cup = shift;
+
+    my $exception = exception { $cup->milk(2) };
+    _test_cup_exception($exception, "milk", ref($cup), "private");
+}
+
+sub _test_cup_exception {
+    my $exception = shift;
+    my $name = shift;
+    my $class_name = shift;
+    my $writer = shift;
+
+    like(
+        $exception,
+        qr/\QCannot assign a value to a read-only accessor (did you mean to call the $writer writer?)\E/,
+        "$class_name: $name read only");
+
+    isa_ok(
+        $exception,
+        "Moose::Exception::CannotAssignValueToReadOnlyAccessor",
+        "$class_name: $name is read only");
+
+    is(
+        $exception->class_name,
+        $class_name,
+        "$class_name: $name is read only");
+
+    is(
+        $exception->attribute_name,
+        $name,
+        "$class_name: $name is read only");
+
+    is(
+        $exception->value,
+        2,
+        "$class_name: $name is read only");
+}
+
 done_testing;