diff --git a/Changes b/Changes index 1f1d4ce11..b00512b55 100644 --- a/Changes +++ b/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] diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm index 890613b9b..18d22333b 100644 --- a/lib/Class/MOP/Method/Accessor.pm +++ b/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,6 +151,9 @@ 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 {', @@ -154,7 +161,8 @@ sub _generate_reader_method_inline { $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]'), diff --git a/lib/Moose/Exception/CannotAssignValueToReadOnlyAccessor.pm b/lib/Moose/Exception/CannotAssignValueToReadOnlyAccessor.pm index 8e06b4437..9b977c8cc 100644 --- a/lib/Moose/Exception/CannotAssignValueToReadOnlyAccessor.pm +++ b/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; diff --git a/t/exceptions/class-mop-method-accessor.t b/t/exceptions/class-mop-method-accessor.t index b83a2dfe1..1fd7bacee 100644 --- a/t/exceptions/class-mop-method-accessor.t +++ b/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;