From 5d3c0f54dc430ee411797a68992c903a34365ca6 Mon Sep 17 00:00:00 2001 From: Mark Fowler Date: Wed, 15 Jul 2015 10:25:18 -0400 Subject: [PATCH 1/6] Make error messages for setting with a reader more awesome If you try and set an attribute with the reader accessor and a different named writer accessor exists the error message now tells you the name of the writer --- lib/Class/MOP/Method/Accessor.pm | 12 ++++- .../CannotAssignValueToReadOnlyAccessor.pm | 12 ++++- t/exceptions/class-mop-method-accessor.t | 50 +++++++++++++++++++ 3 files changed, 70 insertions(+), 4 deletions(-) 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..02e9c9e05 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,17 @@ has 'value' => ( required => 1 ); +has 'suggested_writer' => ( + is => 'ro', + isa => 'Str', + predicate => 'has_suggested_writer', +); + sub _build_message { my $self = shift; - "Cannot assign a value to a read-only accessor"; + return "Cannot assign a value to a read-only accessor" + unless $self->has_suggested_writer; + return "Cannot assign a value to a read-only accessor (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..bbf78544e 100644 --- a/t/exceptions/class-mop-method-accessor.t +++ b/t/exceptions/class-mop-method-accessor.t @@ -276,4 +276,54 @@ use Moose(); 120, "x is read only"); } + +{ + { + package CupOfTea; + use metaclass; + + CupOfTea->meta->add_attribute('sugars' => ( + reader => 'sugars', + writer => 'set_sugars', + init_arg => 'sugars' + )); + + sub new { + my $class = shift; + bless $class->meta->new_object(@_) => $class; + } + } + + my $cup_of_tea = CupOfTea->new(); + + my $exception = exception { + $cup_of_tea->sugars(2); + }; + + like( + $exception, + qr/\QCannot assign a value to a read-only accessor (did you mean to call the 'set_sugars' writer?)\E/, + "sugars is read only"); + + isa_ok( + $exception, + "Moose::Exception::CannotAssignValueToReadOnlyAccessor", + "sugars is read only"); + + is( + $exception->class_name, + "CupOfTea", + "sugars is read only"); + + is( + $exception->attribute_name, + "sugars", + "sugars is read only"); + + is( + $exception->value, + 2, + "sugars is read only"); +} + done_testing; From c5a89bee7ae1551d287d5baf605959fd5e30cc8a Mon Sep 17 00:00:00 2001 From: Mark Fowler Date: Wed, 15 Jul 2015 11:07:01 -0400 Subject: [PATCH 2/6] update changes to reflect more awesome error messages --- Changes | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Changes b/Changes index 1f1d4ce11..3c801fc3d 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,13 @@ for, noteworthy changes. {{$NEXT}} + [ENHANCEMENTS] + + - When attempting to erronously set an attribute with a read-only accessor the + Moose::Exception::CannotAssignValueToReadOnlyAccessor error raised now has + an error message containing the name of the writer accessor that you + probably meant to call if such an accessor exists (Mark Fowler) + 2.1500 2015-06-30 (TRIAL RELEASE) [ENHANCEMENTS] From 5309ee9884cdfb0d0b09aaf0fbfbe9a71bf572ae Mon Sep 17 00:00:00 2001 From: Mark Fowler Date: Wed, 15 Jul 2015 15:45:09 -0400 Subject: [PATCH 3/6] test inline accessor changes too --- t/exceptions/class-mop-method-accessor.t | 44 ++++++++++++++++++------ 1 file changed, 34 insertions(+), 10 deletions(-) diff --git a/t/exceptions/class-mop-method-accessor.t b/t/exceptions/class-mop-method-accessor.t index bbf78544e..6f07ff907 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(); @@ -277,6 +278,9 @@ use Moose(); "x is read only"); } +# we need to do this test as well as the moose one before so we can +# test the non-inlined accessors (since if we test with moose straight +# away we'll only test non-inlined accessors) { { package CupOfTea; @@ -294,36 +298,56 @@ use Moose(); } } - my $cup_of_tea = CupOfTea->new(); + my $cup = CupOfTea->new(); + _test_sugar($cup, "tea"); +} - my $exception = exception { - $cup_of_tea->sugars(2); - }; +{ + { + package CupOfCoffee; + use Moose; + + has 'sugars' => ( + is => 'rw', + writer => 'set_sugars', + ); + } + + my $cup = CupOfCoffee->new(); + _test_sugar($cup, "coffee"); +} + +sub _test_sugar { + my $cup = shift; + my $name = shift; + + my $exception = exception { $cup->sugars(2) }; like( $exception, qr/\QCannot assign a value to a read-only accessor (did you mean to call the 'set_sugars' writer?)\E/, - "sugars is read only"); + "$name: sugar is read only"); isa_ok( $exception, "Moose::Exception::CannotAssignValueToReadOnlyAccessor", - "sugars is read only"); + "$name: sugar is read only"); is( $exception->class_name, - "CupOfTea", - "sugars is read only"); + ref $cup, + "$name: sugar is read only"); is( $exception->attribute_name, "sugars", - "sugars is read only"); + "$name: sugar is read only"); is( $exception->value, 2, - "sugars is read only"); + "$name: sugar is read only"); } + done_testing; From f8798166cec2fc617aac4a0a70cd07d2b72ed417 Mon Sep 17 00:00:00 2001 From: Mark Fowler Date: Wed, 15 Jul 2015 15:58:51 -0400 Subject: [PATCH 4/6] Don't suggest private writer names in error message --- .../CannotAssignValueToReadOnlyAccessor.pm | 9 ++-- t/exceptions/class-mop-method-accessor.t | 52 ++++++++++++++----- 2 files changed, 45 insertions(+), 16 deletions(-) diff --git a/lib/Moose/Exception/CannotAssignValueToReadOnlyAccessor.pm b/lib/Moose/Exception/CannotAssignValueToReadOnlyAccessor.pm index 02e9c9e05..9b977c8cc 100644 --- a/lib/Moose/Exception/CannotAssignValueToReadOnlyAccessor.pm +++ b/lib/Moose/Exception/CannotAssignValueToReadOnlyAccessor.pm @@ -17,11 +17,14 @@ has 'suggested_writer' => ( predicate => 'has_suggested_writer', ); +my $MESSAGE = "Cannot assign a value to a read-only accessor"; + sub _build_message { my $self = shift; - return "Cannot assign a value to a read-only accessor" - unless $self->has_suggested_writer; - return "Cannot assign a value to a read-only accessor (did you mean to call the '".$self->suggested_writer."' writer?)"; + 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 6f07ff907..cc3ec56fa 100644 --- a/t/exceptions/class-mop-method-accessor.t +++ b/t/exceptions/class-mop-method-accessor.t @@ -292,6 +292,12 @@ use Moose(); 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; @@ -299,7 +305,8 @@ use Moose(); } my $cup = CupOfTea->new(); - _test_sugar($cup, "tea"); + _test_sugars($cup); + _test_milk($cup); } { @@ -311,43 +318,62 @@ use Moose(); is => 'rw', writer => 'set_sugars', ); + + has 'milk' => ( + is => 'rw', + writer => '_set_milk', + ); } my $cup = CupOfCoffee->new(); - _test_sugar($cup, "coffee"); + _test_sugars($cup); + _test_milk($cup); } -sub _test_sugar { +sub _test_sugars { my $cup = shift; - my $name = 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 'set_sugars' writer?)\E/, - "$name: sugar is read only"); + 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", - "$name: sugar is read only"); + "$class_name: $name is read only"); is( $exception->class_name, - ref $cup, - "$name: sugar is read only"); + $class_name, + "$class_name: $name is read only"); is( $exception->attribute_name, - "sugars", - "$name: sugar is read only"); + $name, + "$class_name: $name is read only"); is( $exception->value, 2, - "$name: sugar is read only"); + "$class_name: $name is read only"); } - done_testing; From 3238e2b13695450a266f31ea4518dad60aecab21 Mon Sep 17 00:00:00 2001 From: Mark Fowler Date: Wed, 15 Jul 2015 16:02:01 -0400 Subject: [PATCH 5/6] Clearer comments --- t/exceptions/class-mop-method-accessor.t | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/t/exceptions/class-mop-method-accessor.t b/t/exceptions/class-mop-method-accessor.t index cc3ec56fa..1fd7bacee 100644 --- a/t/exceptions/class-mop-method-accessor.t +++ b/t/exceptions/class-mop-method-accessor.t @@ -278,9 +278,10 @@ use Moose(); "x is read only"); } -# we need to do this test as well as the moose one before so we can -# test the non-inlined accessors (since if we test with moose straight -# away we'll only test non-inlined accessors) +# 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; From 512efcc6488e98abb5f91da09060eb9febf7f2f5 Mon Sep 17 00:00:00 2001 From: Mark Fowler Date: Wed, 15 Jul 2015 16:10:51 -0400 Subject: [PATCH 6/6] Reword the changes for improved read-only accessor error messages Change the changes to reflect that private accessors are no longer named --- Changes | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/Changes b/Changes index 3c801fc3d..b00512b55 100644 --- a/Changes +++ b/Changes @@ -5,10 +5,11 @@ for, noteworthy changes. [ENHANCEMENTS] - - When attempting to erronously set an attribute with a read-only accessor the - Moose::Exception::CannotAssignValueToReadOnlyAccessor error raised now has - an error message containing the name of the writer accessor that you - probably meant to call if such an accessor exists (Mark Fowler) + - 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)