From: Stevan Little <stevan.little@iinteractive.com>
Date: Thu, 30 Mar 2006 17:29:06 +0000 (+0000)
Subject: 0_23
X-Git-Tag: 0_24~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b9dfbf78527011f5752e3ec901141e52ee1bb6b1;p=gitmo%2FClass-MOP.git

0_23
---

diff --git a/Changes b/Changes
index b460151..3aa8709 100644
--- a/Changes
+++ b/Changes
@@ -1,9 +1,17 @@
 Revision history for Perl extension Class-MOP.
 
-0.23
+0.23 Thurs. March 30, 2006
 	* Class::MOP::Class
 	  - fixed the way attribute defaults are handled 
 	    during instance construction (bug found by chansen)
+	    
+	* Class::MOP::Attribute
+	  - read-only accessors ('reader') will now die if 
+	    passed more than one argument (attempting to write
+	    to them basically)
+	      - added tests for this
+	      - adjusted all /example files to comply 
+	    
 
 0.22 Mon. March 20, 2006
     * Class::MOP::Class
diff --git a/examples/ClassEncapsulatedAttributes.pod b/examples/ClassEncapsulatedAttributes.pod
index 3c6776a..0b86031 100644
--- a/examples/ClassEncapsulatedAttributes.pod
+++ b/examples/ClassEncapsulatedAttributes.pod
@@ -68,6 +68,7 @@ sub generate_reader_method {
     my ($self, $attr_name) = @_; 
     my $class_name = $self->associated_class->name;
     eval qq{sub {
+        Carp::confess "Cannot assign a value to a read-only accessor" if \@_ > 1;
         \$_[0]->{'$class_name'}->{'$attr_name'};
     }};   
 }
diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod
index 1139f92..1de1123 100644
--- a/examples/InsideOutClass.pod
+++ b/examples/InsideOutClass.pod
@@ -42,6 +42,7 @@ use warnings;
 
 our $VERSION = '0.04';
 
+use Carp         'confess';
 use Scalar::Util 'refaddr';
 
 use base 'Class::MOP::Attribute';
@@ -58,6 +59,7 @@ sub generate_accessor_method {
 sub generate_reader_method {
     my ($self, $attr_name) = @_;     
     eval 'sub {
+        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
         $' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) };
     }';   
 }
diff --git a/examples/LazyClass.pod b/examples/LazyClass.pod
index e4c7635..690007f 100644
--- a/examples/LazyClass.pod
+++ b/examples/LazyClass.pod
@@ -32,6 +32,8 @@ package # hide the package from PAUSE
 use strict;
 use warnings;
 
+use Carp 'confess';
+
 our $VERSION = '0.02';
 
 use base 'Class::MOP::Attribute';
@@ -55,6 +57,7 @@ sub generate_accessor_method {
 sub generate_reader_method {
     my ($self, $attr_name) = @_; 
     sub {
+        confess "Cannot assign a value to a read-only accessor" if @_ > 1;        
         if (!exists $_[0]->{$attr_name}) {
             my $attr = $self->associated_class->get_attribute($attr_name);
             $_[0]->{$attr_name} = $attr->has_default ? $attr->default($_[0]) : undef;           
diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index fa13bf3..748bafa 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -7,7 +7,7 @@ use warnings;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 
-our $VERSION = '0.04';
+our $VERSION = '0.05';
 
 sub meta { 
     require Class::MOP::Class;
@@ -122,7 +122,10 @@ sub generate_accessor_method {
 
 sub generate_reader_method {
     my ($self, $attr_name) = @_; 
-    sub { $_[0]->{$attr_name} };   
+    sub { 
+        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
+        $_[0]->{$attr_name}; 
+    };   
 }
 
 sub generate_writer_method {
diff --git a/t/011_create_class.t b/t/011_create_class.t
index b102d1b..15252b6 100644
--- a/t/011_create_class.t
+++ b/t/011_create_class.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 27;
+use Test::More tests => 28;
 use Test::Exception;
 
 BEGIN {
@@ -75,7 +75,9 @@ is($point->y, 42, '... the $.y attribute was set properly with the accessor');
 
 is($point->x, 2, '... the $.x attribute was initialized correctly through the metaobject');
 
-$point->x(42);
+dies_ok {
+    $point->x(42);
+} '... cannot write to a read-only accessor';
 is($point->x, 2, '... the $.x attribute was not altered');
 
 $point->clear();
diff --git a/t/013_add_attribute_alternate.t b/t/013_add_attribute_alternate.t
index 03cd2df..ca70fe2 100644
--- a/t/013_add_attribute_alternate.t
+++ b/t/013_add_attribute_alternate.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 27;
+use Test::More tests => 28;
 use Test::Exception;
 
 BEGIN {
@@ -73,7 +73,9 @@ is($point->y, 42, '... the $.y attribute was set properly with the accessor');
 
 is($point->x, 2, '... the $.x attribute was initialized correctly through the metaobject');
 
-$point->x(42);
+dies_ok {
+    $point->x(42);
+} '... cannot write to a read-only accessor';
 is($point->x, 2, '... the $.x attribute was not altered');
 
 $point->clear();