From: Matt S Trout <mst@shadowcat.co.uk>
Date: Wed, 20 Jul 2011 04:24:01 +0000 (+0000)
Subject: make ro accessor die
X-Git-Tag: release_0.009009~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=33d3573585bd07ae1c88e7075716821837460d3d;p=gitmo%2FMoo.git

make ro accessor die
---

diff --git a/Changes b/Changes
index 77cfdc7..dcbee41 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - perl based getter dies if @_ > 1 (XSAccessor already did)
   - add Role::Tiny::With for use in classes
   - automatically generate constructors in subclasses when required so that
     subclasses with a BUILD method but no attributes get it honoured
diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 078e884..c5398cf 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -7,6 +7,8 @@ use Sub::Quote;
 use B 'perlstring';
 BEGIN {
   our $CAN_HAZ_XS =
+    !$ENV{MOO_XS_DISABLE}
+      &&
     _maybe_load_module('Class::XSAccessor')
       &&
     (Class::XSAccessor->VERSION > 1.06)
@@ -38,7 +40,8 @@ sub generate_method {
       $self->{captures} = {};
       $methods{$reader} =
         quote_sub "${into}::${reader}"
-          => $self->_generate_get($name, $spec)
+          => '    die "'.$reader.' is a read-only accessor" if @_ > 1;'."\n"
+             .$self->_generate_get($name, $spec)
           => delete $self->{captures}
         ;
     }
diff --git a/t/accessor-reader-writer.t b/t/accessor-reader-writer.t
index da0ef89..68a0ae5 100644
--- a/t/accessor-reader-writer.t
+++ b/t/accessor-reader-writer.t
@@ -33,6 +33,8 @@ is( $foo->get_one, 'lol', 'reader works' );
 $foo->set_one('rofl');
 is( $foo->get_one, 'rofl', 'writer works' );
 
+ok( !eval { $foo->get_one('blah'); 1 }, 'reader dies on write' );
+
 is( $bar->TWO, '...', 'accessor works for reading' );
 $bar->TWO('!!!');
 is( $bar->TWO, '!!!', 'accessor works for writing' );
diff --git a/t/method-generate-accessor.t b/t/method-generate-accessor.t
index 6bd74e4..9c16b72 100644
--- a/t/method-generate-accessor.t
+++ b/t/method-generate-accessor.t
@@ -28,7 +28,7 @@ like(
 my $foo = Foo->new(one => 1);
 
 is($foo->one, 1, 'ro reads');
-$foo->one(-3) unless $Method::Generate::Accessor::CAN_HAZ_XS;
+ok(!eval { $foo->one(-3); 1 }, 'ro dies on write attempt');
 is($foo->one, 1, 'ro does not write');
 
 is($foo->two, undef, 'rw reads');